Clean up treatment of fast-math flags during parsing

Currently, `llvm-pretty-bc-parser` skips over fast-math flags when parsing.
However, it was doing so incorrectly when parsing `FUNC_CODE_INST_CMP2` (i.e.,
`fcmp` instructions). Per the LLVM source code
[here](https://github.com/llvm/llvm-project/blob/b0391dfc737ede147e128fe877045f61fc5e4905/llvm/lib/Bitcode/Reader/BitcodeReader.cpp#L4342-L4377),
the fast-math flags are expected to come after all of the other fields, but the
code in `llvm-pretty-bc-parser` was assuming that they would appear in the
middle. See #158.

I addresses this issue by parsing all of the other fields upfront and avoiding
parsing the last part, which correspond to fast-math flags. While I was in
town, I also made sure to add comments in every other place in the parser where
we avoid parsing fast-math flags.

disasm-test/tests/fcmp-fast-math.ll

@@ -0,0 +1,23 @@
+; ModuleID = 'test.c'
+source_filename = "test.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-pc-linux-gnu"
+
+; Function Attrs: norecurse nounwind readnone uwtable
+define dso_local double @f(double %a) local_unnamed_addr #0 {
+entry:
+  %tobool = fcmp fast une double %a, 0.000000e+00
+  %inc = fadd fast double %a, 1.000000e+00
+  %a.addr.0 = select i1 %tobool, double %inc, double %a
+  ret double %a.addr.0
+}
+
+attributes #0 = { norecurse nounwind readnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="none" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="true" "no-jump-tables"="false" "no-nans-fp-math"="true" "no-signed-zeros-fp-math"="true" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="true" "use-soft-float"="false" }
+
+!llvm.module.flags = !{!0}
+!llvm.ident = !{!1}
+!llvm.commandline = !{!2}
+
+!0 = !{i32 1, !"wchar_size", i32 4}
+!1 = !{!"clang version 10.0.0-4ubuntu1 "}
+!2 = !{!"/usr/lib/llvm-10/bin/clang -O3 test.c -emit-llvm -S -fno-discard-value-names -frecord-command-line -ffast-math"}

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

@@ -21,10 +21,9 @@ import           Text.LLVM.AST
 import           Text.LLVM.Labels
 import           Text.LLVM.PP
 
-import           Control.Monad (when,unless,mplus,mzero,foldM,(<=<),msum)
+import           Control.Monad (when,unless,mplus,mzero,foldM,(<=<))
 import           Data.Bits (shiftR,bit,shiftL,testBit,(.&.),(.|.),complement,Bits)
 import           Data.Int (Int32)
-import           Data.Maybe (isJust)
 import           Data.Word (Word32)
 import qualified Data.Foldable as F
 import qualified Data.IntMap as IntMap
@@ -386,9 +385,20 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     (lhs,ix) <- getValueTypePair t r 0
     rhs      <- getValue t (typedType lhs) =<< field ix numeric
     mkInstr  <- field (ix + 1) binop
-    -- if there's an extra field on the end of the record, it's for designating
-    -- the value of the nuw and nsw flags.  the constructor returned from binop
-    -- will use that value when constructing the binop.
+    -- If there's an extra field on the end of the record, it's for one of the
+    -- following:
+    --
+    -- * If the instruction is add, sub, mul, or shl, the extra field
+    --   designates the value of the nuw and nsw flags.
+    --
+    -- * If the instruction is sdiv, udiv, lshr, or ashr, the extra field
+    --   designates the value of the exact flag.
+    --
+    -- * If the instruction is floating-point, the extra field designates the
+    --   value of the fast-math flags. We currently ignore these.
+    --
+    -- The constructor returned from binop will use that value when
+    -- constructing the binop.
     let mbWord = numeric =<< fieldAt (ix + 2) r
     result (typedType lhs) (mkInstr mbWord lhs (typedValue rhs)) d
 
@@ -550,6 +560,7 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     -- cause a loop.
     useRelIds <- getRelIds
     args      <- parsePhiArgs useRelIds t r
+    -- XXX: we're ignoring the fast-math flags
     result ty (Phi ty args) d
 
   -- 17 is unused
@@ -658,6 +669,7 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     (tv,ix) <- getValueTypePair t r 0
     fv      <- getValue t (typedType tv) =<< field ix numeric
     (c,_)   <- getValueTypePair t r (ix+1)
+    -- XXX: we're ignoring the fast-math flags
     result (typedType tv) (Select c tv (typedValue fv)) d
 
   30 -> label "FUNC_CODE_INST_INBOUNDS_GEP_OLD" (parseGEP t (Just True) r d)
@@ -682,7 +694,7 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
 
     -- pal <- field 0 numeric -- N.B. skipping param attributes
     ccinfo <- field 1 numeric
-    let ix0 = if testBit ccinfo 17 then 3 else 2 -- N.B. skipping fast math flags
+    let ix0 = if testBit ccinfo 17 then 3 else 2 -- N.B. skipping fast-math flags
     (mbFnTy, ix1) <- if testBit (ccinfo :: Word32) 15
                        then do fnTy <- getType =<< field ix0 numeric
                                return (Just fnTy, ix0+1)
@@ -980,6 +992,7 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     let field = parseField r
     (v,ix)  <- getValueTypePair t r 0
     mkInstr <- field ix unop
+    -- XXX: we're ignoring the fast-math flags
     result (typedType v) (mkInstr v) d
 
 
@@ -988,26 +1001,11 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
    |  code == 9
    || code == 28 -> label "FUNC_CODE_INST_CMP2" $ do
     let field = parseField r
-    (lhs,ix0) <- getValueTypePair t r 0
-                `mplus` (do i   <- adjustId =<< field 0 numeric
-                            cxt <- getContext
-                            return (forwardRef cxt i t, 1))
-
-    _predval  <- field ix0 unsigned
-    let isfp = isJust $ msum [ do pty <- elimPrimType (typedType lhs)
-                                  _   <- elimFloatType pty
-                                  return ()
-
-                             , do (_,vty) <- elimVector (typedType lhs)
-                                  pty     <- elimPrimType vty
-                                  _       <- elimFloatType pty
-                                  return () ]
-
-    -- XXX: we're ignoring the fast math flags
-    let ix1 | isfp && length (recordFields r) > 3 = ix0 + 1
-            | otherwise                           = ix0
-
-    rhs <- getValue t (typedType lhs) =<< field ix1 numeric
+    (lhs,ix) <- getValueTypePair t r 0
+               `mplus` (do i   <- adjustId =<< field 0 numeric
+                           cxt <- getContext
+                           return (forwardRef cxt i t, 1))
+    rhs <- getValue t (typedType lhs) =<< field ix numeric
 
     let ty = typedType lhs
         parseOp | isPrimTypeOf isFloatingPoint ty ||
@@ -1017,7 +1015,8 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
                 | otherwise =
                   return . ICmp <=< icmpOp
 
-    op <- field (ix1 + 1) parseOp
+    op <- field (ix + 1) parseOp
+    -- XXX: we're ignoring the fast-math flags
 
     let boolTy = Integer 1
     let rty = case ty of