Support parsing fneg instructions

This is sufficient to parse the SQLite test case mentioned in #148. I have
added a much more minimal test case which exercises the new `fneg`-related
code paths added in this patch.

Fixes #148.

disasm-test/tests/fneg.ll

@@ -0,0 +1,14 @@
+define double @real_fneg(double %X) {
+        %Y = fneg double %X               ; <double> [#uses=1]
+        ret double %Y
+}
+
+define double @real_fneg_constant() {
+        %Y = fneg double -2.0             ; <double> [#uses=1]
+        ret double %Y
+}
+
+define float @real_fnegf(float %X) {
+        %Y = fneg float %X                ; <float> [#uses=1]
+        ret float %Y
+}

src/Data/LLVM/BitCode/IR/Constants.hs

@@ -134,6 +134,23 @@ icmpOp  = choose <=< numeric
   choose 41 = return Isle
   choose _  = mzero
 
+unopGeneric :: forall a.
+               (UnaryArithOp -> Typed PValue -> a)
+            -> Match Field (Typed PValue -> a)
+unopGeneric uaop = choose <=< numeric
+  where
+  choose :: Match Int (Typed PValue -> a)
+  choose 0 = return (uaop FNeg)
+  choose _ = mzero
+
+unop :: Match Field (Typed PValue -> PInstr)
+unop = unopGeneric UnaryArith
+
+unopCE :: Match Field (Typed PValue -> PValue)
+unopCE = unopGeneric uaop
+  where
+  uaop op tv = ValConstExpr (ConstUnaryArith op tv)
+
 castOpGeneric :: forall c. (ConvOp -> Maybe c) -> Match Field c
 castOpGeneric op = choose <=< numeric
   where
@@ -428,6 +445,15 @@ parseConstantEntry t (getTy,cs) (fromEntry -> Just r) =
     v <- parseCeGep inBounds (Just inRangeIndex) t r
     return (getTy,Typed ty v:cs)
 
+  -- [opcode, opval]
+  25 -> label "CST_CODE_CE_UNOP" $ do
+    let field = parseField r
+    ty      <- getTy
+    mkInstr <- field 0 unopCE
+    opval   <- field 1 numeric
+    cxt     <- getContext
+    let v = forwardRef cxt opval t
+    return (getTy, Typed ty (mkInstr v) : cs)
 
 
   code -> Assert.unknownEntity "constant record code" code

src/Data/LLVM/BitCode/IR/Function.hs

@@ -975,6 +975,14 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
   55 -> label "FUNC_CODE_OPERAND_BUNDLE" $ do
     notImplemented
 
+  -- [opval,ty,opcode]
+  56 -> label "FUNC_CODE_INST_UNOP" $ do
+    let field = parseField r
+    (v,ix)  <- getValueTypePair t r 0
+    mkInstr <- field ix unop
+    result (typedType v) (mkInstr v) d
+
+
   -- [opty,opval,opval,pred]
   code
    |  code == 9

unit-test/Tests/Instances.hs

@@ -36,6 +36,7 @@ instance Arbitrary Linkage                                            where arbi
 instance Arbitrary Visibility                                         where arbitrary = genericArbitrary uniform
 instance Arbitrary lab => Arbitrary (Typed lab)                       where arbitrary = genericArbitrary uniform
 instance Arbitrary ArithOp                                            where arbitrary = genericArbitrary uniform
+instance Arbitrary UnaryArithOp                                       where arbitrary = genericArbitrary uniform
 instance Arbitrary BitOp                                              where arbitrary = genericArbitrary uniform
 instance Arbitrary ConvOp                                             where arbitrary = genericArbitrary uniform
 instance Arbitrary AtomicRWOp                                         where arbitrary = genericArbitrary uniform