Add support for the FNeg instruction

llvm-hs · Apr 28, 2021 · 7217274 · 7217274
1 parent b0126bf
commit 7217274
Show file tree

Hide file tree

Showing 8 changed files with 173 additions and 136 deletions.
diff --git a/llvm-hs-pure/src/LLVM/AST/Instruction.hs b/llvm-hs-pure/src/LLVM/AST/Instruction.hs
@@ -1,4 +1,4 @@
--- | LLVM instructions 
+-- | LLVM instructions
 -- <http://llvm.org/docs/LangRef.html#instruction-reference>
 module LLVM.AST.Instruction where
 
@@ -22,18 +22,18 @@ import Data.List.NonEmpty
 type InstructionMetadata = [(ShortByteString, MDRef MDNode)]
 
 -- | <http://llvm.org/docs/LangRef.html#terminators>
-data Terminator 
-  = Ret { 
+data Terminator
+  = Ret {
       returnOperand :: Maybe Operand,
       metadata' :: InstructionMetadata
     }
-  | CondBr { 
-      condition :: Operand, 
-      trueDest :: Name, 
+  | CondBr {
+      condition :: Operand,
+      trueDest :: Name,
       falseDest :: Name,
       metadata' :: InstructionMetadata
     }
-  | Br { 
+  | Br {
       dest :: Name,
       metadata' :: InstructionMetadata
     }
@@ -84,7 +84,7 @@ data Terminator
   deriving (Eq, Read, Show, Typeable, Data, Generic)
 
 -- | <http://llvm.org/docs/LangRef.html#fast-math-flags>
-data FastMathFlags 
+data FastMathFlags
   = FastMathFlags {
       allowReassoc :: Bool,
       noNaNs :: Bool,
@@ -140,12 +140,18 @@ data TailCallKind = Tail | MustTail | NoTail
     deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
 
 -- | non-terminator instructions:
+-- <http://llvm.org/docs/LangRef.html#unaryops>
 -- <http://llvm.org/docs/LangRef.html#binaryops>
 -- <http://llvm.org/docs/LangRef.html#bitwiseops>
 -- <http://llvm.org/docs/LangRef.html#memoryops>
 -- <http://llvm.org/docs/LangRef.html#otherops>
 data Instruction
-  = Add { 
+  = FNeg {
+    fastMathFlags :: FastMathFlags,
+    operand0 :: Operand,
+    metadata :: InstructionMetadata
+    }
+  | Add {
       nsw :: Bool,
       nuw :: Bool,
       operand0 :: Operand,
@@ -165,150 +171,150 @@ data Instruction
       operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | FSub { 
+  | FSub {
       fastMathFlags :: FastMathFlags,
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | Mul { 
-      nsw :: Bool, 
-      nuw :: Bool, 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
-      metadata :: InstructionMetadata 
+  | Mul {
+      nsw :: Bool,
+      nuw :: Bool,
+      operand0 :: Operand,
+      operand1 :: Operand,
+      metadata :: InstructionMetadata
     }
-  | FMul { 
+  | FMul {
       fastMathFlags :: FastMathFlags,
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | UDiv { 
-      exact :: Bool, 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | UDiv {
+      exact :: Bool,
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | SDiv { 
-      exact :: Bool, 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | SDiv {
+      exact :: Bool,
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | FDiv { 
+  | FDiv {
       fastMathFlags :: FastMathFlags,
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | URem { 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | URem {
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | SRem { 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | SRem {
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | FRem { 
+  | FRem {
       fastMathFlags :: FastMathFlags,
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | Shl { 
-      nsw :: Bool, 
-      nuw :: Bool, 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | Shl {
+      nsw :: Bool,
+      nuw :: Bool,
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | LShr { 
-      exact :: Bool, 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | LShr {
+      exact :: Bool,
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | AShr { 
-      exact :: Bool, 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | AShr {
+      exact :: Bool,
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | And { 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | And {
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | Or { 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | Or {
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | Xor { 
-      operand0 :: Operand, 
-      operand1 :: Operand, 
+  | Xor {
+      operand0 :: Operand,
+      operand1 :: Operand,
       metadata :: InstructionMetadata
     }
-  | Alloca { 
+  | Alloca {
       allocatedType :: Type,
       numElements :: Maybe Operand,
       alignment :: Word32,
       metadata :: InstructionMetadata
     }
   | Load {
-      volatile :: Bool, 
+      volatile :: Bool,
       address :: Operand,
       maybeAtomicity :: Maybe Atomicity,
       alignment :: Word32,
       metadata :: InstructionMetadata
     }
   | Store {
-      volatile :: Bool, 
+      volatile :: Bool,
       address :: Operand,
       value :: Operand,
       maybeAtomicity :: Maybe Atomicity,
       alignment :: Word32,
       metadata :: InstructionMetadata
     }
-  | GetElementPtr { 
+  | GetElementPtr {
       inBounds :: Bool,
       address :: Operand,
       indices :: [Operand],
       metadata :: InstructionMetadata
     }
-  | Fence { 
+  | Fence {
       atomicity :: Atomicity,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
-  | CmpXchg { 
+  | CmpXchg {
       volatile :: Bool,
       address :: Operand,
       expected :: Operand,
       replacement :: Operand,
       atomicity :: Atomicity,
       failureMemoryOrdering :: MemoryOrdering,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
-  | AtomicRMW { 
+  | AtomicRMW {
       volatile :: Bool,
       rmwOperation :: RMWOperation,
       address :: Operand,
       value :: Operand,
       atomicity :: Atomicity,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
-  | Trunc { 
+  | Trunc {
       operand0 :: Operand,
       type' :: Type,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
   | ZExt {
       operand0 :: Operand,
       type' :: Type,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
   | SExt {
       operand0 :: Operand,
@@ -381,7 +387,7 @@ data Instruction
       type' :: Type,
       incomingValues :: [ (Operand, Name) ],
       metadata :: InstructionMetadata
-  } 
+  }
   | Freeze {
       operand0 :: Operand,
       type' :: Type,
@@ -402,44 +408,44 @@ data Instruction
       functionAttributes :: [Either FA.GroupID FA.FunctionAttribute],
       metadata :: InstructionMetadata
   }
-  | VAArg { 
+  | VAArg {
       argList :: Operand,
       type' :: Type,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
-  | ExtractElement { 
+  | ExtractElement {
       vector :: Operand,
       index :: Operand,
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
-  | InsertElement { 
+  | InsertElement {
       vector :: Operand,
       element :: Operand,
       index :: Operand,
       metadata :: InstructionMetadata
     }
-  | ShuffleVector { 
+  | ShuffleVector {
       operand0 :: Operand,
       operand1 :: Operand,
       mask :: [Int32],
       metadata :: InstructionMetadata
     }
-  | ExtractValue { 
+  | ExtractValue {
       aggregate :: Operand,
       indices' :: [Word32],
       metadata :: InstructionMetadata
     }
-  | InsertValue { 
+  | InsertValue {
       aggregate :: Operand,
       element :: Operand,
       indices' :: [Word32],
       metadata :: InstructionMetadata
     }
-  | LandingPad { 
+  | LandingPad {
       type' :: Type,
       cleanup :: Bool,
       clauses :: [LandingPadClause],
-      metadata :: InstructionMetadata 
+      metadata :: InstructionMetadata
     }
   | CatchPad {
       catchSwitch :: Operand,
@@ -456,7 +462,7 @@ data Instruction
 
 -- | Instances of instructions may be given a name, allowing their results to be referenced as 'Operand's.
 -- Sometimes instructions - e.g. a call to a function returning void - don't need names.
-data Named a 
+data Named a
   = Name := a
   | Do a
   deriving (Eq, Read, Show, Typeable, Data, Generic)
diff --git a/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs b/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs
@@ -27,6 +27,10 @@ import LLVM.AST.Linkage
 import LLVM.IRBuilder.Monad
 import LLVM.IRBuilder.Module
 
+-- | See <https://llvm.org/docs/LangRef.html#fneg-instruction reference>.
+fneg :: MonadIRBuilder m => Operand -> m Operand
+fneg a = emitInstr (typeOf a) $ FNeg noFastMathFlags a []
+
 -- | See <https://llvm.org/docs/LangRef.html#fadd-instruction reference>.
 fadd :: MonadIRBuilder m => Operand -> Operand -> m Operand
 fadd a b = emitInstr (typeOf a) $ FAdd noFastMathFlags a b []

diff --git a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs
@@ -86,6 +86,7 @@ $(do
     let ats = map typeMapping (fieldTypes List.\\ [TH.ConT ''A.InstructionMetadata, TH.ConT ''A.FastMathFlags])
         cName = "LLVM_Hs_Build" ++ a
     rt <- case k of
+            ID.Unary -> [[t| UnaryOperator |]]
             ID.Binary -> [[t| BinaryOperator |]]
             ID.Cast -> [[t| Instruction |]]
             _ -> []

diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp
@@ -121,6 +121,18 @@ LLVMValueRef LLVM_Hs_Build##Op(LLVMBuilderRef b, LLVMValueRef lhs, LLVMValueRef
 LLVM_HS_FOR_EACH_BINOP(ENUM_CASE)
 #undef ENUM_CASE
 
+#define LLVM_HS_FOR_EACH_FP_UNOP(macro) \
+    macro(FNeg)
+
+#define ENUM_CASE(Op) \
+LLVMValueRef LLVM_Hs_Build##Op(LLVMBuilderRef b, LLVMValueRef rhs, const char *name) { \
+    UnaryOperator* uo = UnaryOperator::Create(Instruction::Op, unwrap(rhs), name); \
+    uo->setFastMathFlags(unwrap(b)->getFastMathFlags()); \
+    return wrap(unwrap(b)->Insert(uo, name)); \
+}
+LLVM_HS_FOR_EACH_FP_UNOP(ENUM_CASE)
+#undef ENUM_CASE
+
 #define LLVM_HS_FOR_EACH_FP_BINOP(macro) \
     macro(FAdd) \
     macro(FDiv) \