llvm-general 3.4.2.2 → 3.4.3.0
raw patch · 29 files changed
+702/−563 lines, 29 filesdep ~llvm-generaldep ~llvm-general-pure
Dependency ranges changed: llvm-general, llvm-general-pure
Files
- llvm-general.cabal +8/−6
- src/LLVM/General/Internal/Constant.hs +4/−2
- src/LLVM/General/Internal/EncodeAST.hs +28/−20
- src/LLVM/General/Internal/FFI/BinaryOperator.h +16/−0
- src/LLVM/General/Internal/FFI/BinaryOperator.hs +2/−0
- src/LLVM/General/Internal/FFI/Builder.hs +25/−14
- src/LLVM/General/Internal/FFI/BuilderC.cpp +21/−21
- src/LLVM/General/Internal/FFI/Cleanup.hs +4/−3
- src/LLVM/General/Internal/FFI/ConstantC.cpp +1/−12
- src/LLVM/General/Internal/FFI/Instruction.h +19/−0
- src/LLVM/General/Internal/FFI/InstructionC.cpp +12/−0
- src/LLVM/General/Internal/FFI/LLVMCTypes.hsc +5/−0
- src/LLVM/General/Internal/FFI/Value.hs +3/−0
- src/LLVM/General/Internal/FFI/ValueC.cpp +9/−0
- src/LLVM/General/Internal/FastMathFlags.hs +49/−0
- src/LLVM/General/Internal/Instruction.hs +158/−247
- src/LLVM/General/Internal/Module.hs +3/−0
- src/LLVM/General/Internal/Operand.hs +16/−2
- test/LLVM/General/Test/Analysis.hs +8/−8
- test/LLVM/General/Test/Constants.hs +35/−35
- test/LLVM/General/Test/ExecutionEngine.hs +2/−2
- test/LLVM/General/Test/Global.hs +3/−2
- test/LLVM/General/Test/InlineAssembly.hs +7/−6
- test/LLVM/General/Test/Instructions.hs +71/−57
- test/LLVM/General/Test/Instrumentation.hs +34/−23
- test/LLVM/General/Test/Linking.hs +4/−4
- test/LLVM/General/Test/Metadata.hs +9/−7
- test/LLVM/General/Test/Module.hs +103/−49
- test/LLVM/General/Test/Optimization.hs +43/−43
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.4.2.2+version: 3.4.3.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -16,9 +16,10 @@ handles almost all of the stateful complexities of using the LLVM API to build IR; and it supports moving IR not only from Haskell into LLVM C++ objects, but the other direction - from LLVM C++ into Haskell. .- For haddock, see <http://bscarlet.github.io/llvm-general/3.4.2.2/doc/html/llvm-general/index.html>.+ For haddock, see <http://bscarlet.github.io/llvm-general/3.4.3.0/doc/html/llvm-general/index.html>. extra-source-files: src/LLVM/General/Internal/FFI/Analysis.h+ src/LLVM/General/Internal/FFI/BinaryOperator.h src/LLVM/General/Internal/FFI/Constant.h src/LLVM/General/Internal/FFI/Function.h src/LLVM/General/Internal/FFI/GlobalValue.h@@ -39,7 +40,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.4- tag: v3.4.2.2+ tag: v3.4.3.0 flag shared-llvm description: link against llvm shared rather than static library@@ -63,7 +64,7 @@ parsec >= 3.1.3, array >= 0.4.0.0, setenv >= 0.1.0,- llvm-general-pure == 3.4.2.2+ llvm-general-pure == 3.4.3.0 extra-libraries: stdc++ hs-source-dirs: src extensions:@@ -109,6 +110,7 @@ LLVM.General.Internal.Diagnostic LLVM.General.Internal.EncodeAST LLVM.General.Internal.ExecutionEngine+ LLVM.General.Internal.FastMathFlags LLVM.General.Internal.FloatingPointPredicate LLVM.General.Internal.Function LLVM.General.Internal.Global@@ -197,8 +199,8 @@ HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1,- llvm-general == 3.4.2.2,- llvm-general-pure == 3.4.2.2,+ llvm-general == 3.4.3.0,+ llvm-general-pure == 3.4.3.0, containers >= 0.4.2.1, mtl >= 2.0.1.0 hs-source-dirs: test
src/LLVM/General/Internal/Constant.hs view
@@ -88,7 +88,7 @@ A.F.PPC_FP128 _ _ -> FFI.floatSemanticsPPCDoubleDouble nBits <- encodeM nBits liftIO $ FFI.constantFloatOfArbitraryPrecision context nBits words fpSem- A.C.GlobalReference n -> FFI.upCast <$> referGlobal n+ A.C.GlobalReference _ n -> FFI.upCast <$> referGlobal n A.C.BlockAddress f b -> do f' <- referGlobal f b' <- getBlockForAddress f b@@ -137,7 +137,9 @@ t <- decodeM ft valueSubclassId <- liftIO $ FFI.getValueSubclassId v nOps <- liftIO $ FFI.getNumOperands u- let globalRef = return A.C.GlobalReference `ap` (getGlobalName =<< liftIO (FFI.isAGlobalValue v))+ let globalRef = return A.C.GlobalReference + `ap` (return t)+ `ap` (getGlobalName =<< liftIO (FFI.isAGlobalValue v)) op = decodeM <=< liftIO . FFI.getConstantOperand c getConstantOperands = mapM op [0..nOps-1] getConstantData = do
src/LLVM/General/Internal/EncodeAST.hs view
@@ -18,6 +18,7 @@ import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.Builder as FFI+import qualified LLVM.General.Internal.FFI.Value as FFI import qualified LLVM.General.AST as A @@ -25,10 +26,14 @@ import LLVM.General.Internal.Coding import LLVM.General.Internal.String () +data LocalValue+ = ForwardValue (Ptr FFI.Value)+ | DefinedValue (Ptr FFI.Value)+ data EncodeState = EncodeState { encodeStateBuilder :: Ptr FFI.Builder, encodeStateContext :: Context,- encodeStateLocals :: Map A.Name (Ptr FFI.Value),+ encodeStateLocals :: Map A.Name LocalValue, encodeStateGlobals :: Map A.Name (Ptr FFI.GlobalValue), encodeStateAllBlocks :: Map (A.Name, A.Name) (Ptr FFI.BasicBlock), encodeStateBlocks :: Map A.Name (Ptr FFI.BasicBlock),@@ -92,32 +97,35 @@ modify (`withLocalsFrom` s') return r -define :: (Ord n, FFI.DescendentOf p v) => - (EncodeState -> Map n (Ptr p))- -> (Map n (Ptr p) -> EncodeState -> EncodeState)- -> n- -> Ptr v- -> EncodeAST ()-define r w n v = modify $ \b -> w (Map.insert n (FFI.upCast v) (r b)) b- defineLocal :: FFI.DescendentOf FFI.Value v => A.Name -> Ptr v -> EncodeAST ()-defineLocal = define encodeStateLocals (\m b -> b { encodeStateLocals = m })+defineLocal n v' = do+ let v = FFI.upCast v'+ def <- gets $ Map.lookup n . encodeStateLocals+ case def of+ Just (ForwardValue dummy) -> liftIO $ FFI.replaceAllUsesWith dummy v+ _ -> return ()+ modify $ \b -> b { encodeStateLocals = Map.insert n (DefinedValue v) (encodeStateLocals b) } defineGlobal :: FFI.DescendentOf FFI.GlobalValue v => A.Name -> Ptr v -> EncodeAST ()-defineGlobal = define encodeStateGlobals (\m b -> b { encodeStateGlobals = m })+defineGlobal n v = modify $ \b -> b { encodeStateGlobals = Map.insert n (FFI.upCast v) (encodeStateGlobals b) } defineMDNode :: A.MetadataNodeID -> Ptr FFI.MDNode -> EncodeAST ()-defineMDNode = define encodeStateMDNodes (\m b -> b { encodeStateMDNodes = m })+defineMDNode n v = modify $ \b -> b { encodeStateMDNodes = Map.insert n (FFI.upCast v) (encodeStateMDNodes b) } -refer :: (Show n, Ord n) => (EncodeState -> Map n (Ptr p)) -> String -> n -> EncodeAST (Ptr p)-refer r m n = do+refer :: (Show n, Ord n) => (EncodeState -> Map n v) -> n -> EncodeAST v -> EncodeAST v+refer r n f = do mop <- gets $ Map.lookup n . r- maybe (fail $ "reference to undefined " ++ m ++ ": " ++ show n) return mop+ maybe f return mop -referLocal = refer encodeStateLocals "local"-referGlobal = refer encodeStateGlobals "global"-referMDNode = refer encodeStateMDNodes "metadata node"+failAsUndefined :: Show n => String -> n -> EncodeAST a+failAsUndefined m n = fail $ "reference to undefined " ++ m ++ ": " ++ show n +referOrFail :: (Show n, Ord n) => (EncodeState -> Map n (Ptr p)) -> String -> n -> EncodeAST (Ptr p)+referOrFail r m n = refer r n $ failAsUndefined m n++referGlobal = referOrFail encodeStateGlobals "global"+referMDNode = referOrFail encodeStateMDNodes "metadata node"+ defineBasicBlock :: A.Name -> A.Name -> Ptr FFI.BasicBlock -> EncodeAST () defineBasicBlock fn n b = modify $ \s -> s { encodeStateBlocks = Map.insert n b (encodeStateBlocks s),@@ -125,8 +133,8 @@ } instance EncodeM EncodeAST A.Name (Ptr FFI.BasicBlock) where- encodeM = refer encodeStateBlocks "block"+ encodeM = referOrFail encodeStateBlocks "block" getBlockForAddress :: A.Name -> A.Name -> EncodeAST (Ptr FFI.BasicBlock)-getBlockForAddress fn n = refer encodeStateAllBlocks "blockaddress" (fn, n)+getBlockForAddress fn n = referOrFail encodeStateAllBlocks "blockaddress" (fn, n)
+ src/LLVM/General/Internal/FFI/BinaryOperator.h view
@@ -0,0 +1,16 @@+#ifndef __LLVM_GENERAL_INTERNAL_FFI__BINARY_OPERATOR__H__+#define __LLVM_GENERAL_INTERNAL_FFI__BINARY_OPERATOR__H__++#define LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(macro) \+ macro(UDiv) \+ macro(SDiv) \+ macro(LShr) \+ macro(AShr)++#define LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(macro) \+ macro(Add) \+ macro(Mul) \+ macro(Shl) \+ macro(Sub) \++#endif
src/LLVM/General/Internal/FFI/BinaryOperator.hs view
@@ -25,3 +25,5 @@ foreign import ccall unsafe "LLVM_General_IsExact" isExact :: Ptr Value -> IO LLVMBool +foreign import ccall unsafe "LLVM_General_GetFastMathFlags" getFastMathFlags ::+ Ptr Value -> IO FastMathFlags
src/LLVM/General/Internal/FFI/Builder.hs view
@@ -18,6 +18,7 @@ import Foreign.Ptr import Foreign.C +import qualified Data.List as List import qualified Data.Map as Map import LLVM.General.Internal.FFI.Cleanup@@ -74,7 +75,7 @@ error $ "LLVM instruction def " ++ lrn ++ " not found in the AST" _ -> [] - let ats = map typeMapping [ t | t <- fieldTypes, t /= TH.ConT ''A.InstructionMetadata ]+ let ats = map typeMapping (fieldTypes List.\\ [TH.ConT ''A.InstructionMetadata, TH.ConT ''A.FastMathFlags]) cName = (if hasFlags fieldTypes then "LLVM_General_" else "LLVM") ++ "Build" ++ a rt <- case k of ID.Binary -> [[t| BinaryOperator |]]@@ -86,32 +87,41 @@ foreign import ccall unsafe "LLVMBuildArrayAlloca" buildAlloca :: Ptr Builder -> Ptr Type -> Ptr Value -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVM_General_BuildLoad" buildLoad ::- Ptr Builder -> Ptr Value -> CUInt -> LLVMBool -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+foreign import ccall unsafe "LLVM_General_BuildLoad" buildLoad' ::+ Ptr Builder -> LLVMBool -> Ptr Value -> MemoryOrdering -> LLVMBool -> CUInt -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVM_General_BuildStore" buildStore ::- Ptr Builder -> Ptr Value -> Ptr Value -> CUInt -> LLVMBool -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+buildLoad builder vol a' (ss, mo) al s = buildLoad' builder vol a' mo ss al s +foreign import ccall unsafe "LLVM_General_BuildStore" buildStore' ::+ Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> MemoryOrdering -> LLVMBool -> CUInt -> CString -> IO (Ptr Instruction)++buildStore builder vol a' v' (ss, mo) al s = buildStore' builder vol a' v' mo ss al s+ foreign import ccall unsafe "LLVMBuildGEP" buildGetElementPtr' :: Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGetElementPtr' :: Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) -buildGetElementPtr :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)-buildGetElementPtr builder (LLVMBool 1) = buildInBoundsGetElementPtr' builder-buildGetElementPtr builder (LLVMBool 0) = buildGetElementPtr' builder+buildGetElementPtr :: Ptr Builder -> LLVMBool -> Ptr Value -> (CUInt, Ptr (Ptr Value)) -> CString -> IO (Ptr Instruction)+buildGetElementPtr builder (LLVMBool 1) a (n, is) s = buildInBoundsGetElementPtr' builder a is n s+buildGetElementPtr builder (LLVMBool 0) a (n, is) s = buildGetElementPtr' builder a is n s -foreign import ccall unsafe "LLVM_General_BuildFence" buildFence ::+foreign import ccall unsafe "LLVM_General_BuildFence" buildFence' :: Ptr Builder -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVM_General_BuildAtomicCmpXchg" buildCmpXchg ::- Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> LLVMBool -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+buildFence builder (ss, mo) s = buildFence' builder mo ss s -foreign import ccall unsafe "LLVM_General_BuildAtomicRMW" buildAtomicRMW ::- Ptr Builder -> RMWOperation -> Ptr Value -> Ptr Value -> LLVMBool -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+foreign import ccall unsafe "LLVM_General_BuildAtomicCmpXchg" buildCmpXchg' ::+ Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction) +buildCmpXchg builder vol a e r (ss, mo) s = buildCmpXchg' builder vol a e r mo ss s +foreign import ccall unsafe "LLVM_General_BuildAtomicRMW" buildAtomicRMW' ::+ Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)++buildAtomicRMW builder vol rmwOp a v (ss, mo) s = buildAtomicRMW' builder vol rmwOp a v mo ss s + foreign import ccall unsafe "LLVMBuildICmp" buildICmp :: Ptr Builder -> ICmpPredicate -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction) @@ -148,4 +158,5 @@ foreign import ccall unsafe "LLVMBuildLandingPad" buildLandingPad :: Ptr Builder -> Ptr Type -> Ptr Value -> CUInt -> CString -> IO (Ptr Instruction) -+foreign import ccall unsafe "LLVM_General_SetFastMathFlags" setFastMathFlags ::+ Ptr Builder -> FastMathFlags -> IO ()
src/LLVM/General/Internal/FFI/BuilderC.cpp view
@@ -5,6 +5,7 @@ #include "llvm-c/Core.h" #include "LLVM/General/Internal/FFI/Instruction.h"+#include "LLVM/General/Internal/FFI/BinaryOperator.h" using namespace llvm; @@ -37,15 +38,17 @@ } } +static FastMathFlags unwrap(LLVMFastMathFlags f) {+ FastMathFlags r = FastMathFlags();+#define ENUM_CASE(x,l) if (f & LLVM ## x) r.set ## x();+LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE)+#undef ENUM_CASE+ return r; } -extern "C" {+} -#define LLVM_GENERAL_FOR_ALL_OVERFLOWING_BINARY_OPERATORS(macro) \- macro(Add) \- macro(Mul) \- macro(Shl) \- macro(Sub) \+extern "C" { #define ENUM_CASE(Op) \ LLVMValueRef LLVM_General_Build ## Op( \@@ -58,15 +61,9 @@ ) { \ return wrap(unwrap(b)->Create ## Op(unwrap(o0), unwrap(o1), s, nuw, nsw)); \ }-LLVM_GENERAL_FOR_ALL_OVERFLOWING_BINARY_OPERATORS(ENUM_CASE)+LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(ENUM_CASE) #undef ENUM_CASE -#define LLVM_GENERAL_FOR_ALL_POSSIBLY_EXACT_OPERATORS(macro) \- macro(AShr) \- macro(LShr) \- macro(SDiv) \- macro(UDiv) \- #define ENUM_CASE(Op) \ LLVMValueRef LLVM_General_Build ## Op( \ LLVMBuilderRef b, \@@ -77,17 +74,20 @@ ) { \ return wrap(unwrap(b)->Create ## Op(unwrap(o0), unwrap(o1), s, exact)); \ }-LLVM_GENERAL_FOR_ALL_POSSIBLY_EXACT_OPERATORS(ENUM_CASE)+LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(ENUM_CASE) #undef ENUM_CASE +void LLVM_General_SetFastMathFlags(LLVMBuilderRef b, LLVMFastMathFlags f) {+ unwrap(b)->SetFastMathFlags(unwrap(f));+} LLVMValueRef LLVM_General_BuildLoad( LLVMBuilderRef b,- LLVMValueRef p,- unsigned align, LLVMBool isVolatile,+ LLVMValueRef p, LLVMAtomicOrdering atomicOrdering, LLVMSynchronizationScope synchScope,+ unsigned align, const char *name ) { LoadInst *i = unwrap(b)->CreateAlignedLoad(unwrap(p), align, isVolatile, name);@@ -98,12 +98,12 @@ LLVMValueRef LLVM_General_BuildStore( LLVMBuilderRef b,- LLVMValueRef v,- LLVMValueRef p,- unsigned align, LLVMBool isVolatile,+ LLVMValueRef p,+ LLVMValueRef v, LLVMAtomicOrdering atomicOrdering, LLVMSynchronizationScope synchScope,+ unsigned align, const char *name ) { StoreInst *i = unwrap(b)->CreateAlignedStore(unwrap(v), unwrap(p), align, isVolatile);@@ -123,10 +123,10 @@ LLVMValueRef LLVM_General_BuildAtomicCmpXchg( LLVMBuilderRef b,+ LLVMBool v, LLVMValueRef ptr, LLVMValueRef cmp, LLVMValueRef n, - LLVMBool v, LLVMAtomicOrdering lao, LLVMSynchronizationScope lss, const char *name@@ -141,10 +141,10 @@ LLVMValueRef LLVM_General_BuildAtomicRMW( LLVMBuilderRef b,+ LLVMBool v, LLVMAtomicRMWBinOp rmwOp, LLVMValueRef ptr, LLVMValueRef val, - LLVMBool v, LLVMAtomicOrdering lao, LLVMSynchronizationScope lss, const char *name
src/LLVM/General/Internal/FFI/Cleanup.hs view
@@ -21,6 +21,7 @@ import qualified LLVM.General.AST.Constant as A.C (Constant) import qualified LLVM.General.AST.Operand as A (Operand) import qualified LLVM.General.AST.Type as A (Type)+import qualified LLVM.General.AST.Instruction as A (FastMathFlags) foreignDecl :: String -> String -> [TypeQ] -> TypeQ -> DecsQ foreignDecl cName hName argTypeQs returnTypeQ = do@@ -62,10 +63,9 @@ ] ] --- | The LLVM C-API for instructions with boolean flags (e.g. nsw) is weak, so they get+-- | The LLVM C-API for instructions with boolean flags (e.g. nsw) and is weak, so they get -- separated out for different handling. This check is an accurate but crude test for whether--- an instruction needs such handling. As such it may need revision in the future (if has-a-boolean-member--- is no longer the same as needs-special-handling).+-- an instruction needs such handling. hasFlags :: [Type] -> Bool hasFlags = any (== ConT ''Bool) @@ -80,5 +80,6 @@ | h == ''A.C.Constant -> [t| Ptr FFI.Constant |] | h == ''A.FloatingPointPredicate -> [t| FCmpPredicate |] | h == ''A.IntegerPredicate -> [t| ICmpPredicate |]+ | h == ''A.FastMathFlags -> [t| FastMathFlags |] AppT ListT x -> foldl1 appT [tupleT 2, [t| CUInt |], appT [t| Ptr |] (typeMapping x)] x -> error $ "type not handled in Cleanup typeMapping: " ++ show x
src/LLVM/General/Internal/FFI/ConstantC.cpp view
@@ -6,6 +6,7 @@ #include "llvm-c/Core.h" #include "LLVM/General/Internal/FFI/Value.h" #include "LLVM/General/Internal/FFI/Constant.h"+#include "LLVM/General/Internal/FFI/BinaryOperator.h" using namespace llvm; @@ -52,24 +53,12 @@ return wrap(ConstantExpr::get(opcode, unwrap<Constant>(o0), unwrap<Constant>(o1))); } -#define LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(macro) \- macro(Add) \- macro(Sub) \- macro(Mul) \- macro(Shl)- #define CASE_CODE(op) \ LLVMValueRef LLVM_General_Const ## op(unsigned nsw, unsigned nuw, LLVMValueRef o0, LLVMValueRef o1) { \ return wrap(ConstantExpr::get ## op(unwrap<Constant>(o0), unwrap<Constant>(o1), nuw != 0, nsw != 0)); \ } LLVM_GENERAL_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(CASE_CODE) #undef CASE_CODE--#define LLVM_GENERAL_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(macro) \- macro(UDiv) \- macro(SDiv) \- macro(LShr) \- macro(AShr) #define CASE_CODE(op) \ LLVMValueRef LLVM_General_Const ## op(unsigned isExact, LLVMValueRef o0, LLVMValueRef o1) { \
src/LLVM/General/Internal/FFI/Instruction.h view
@@ -35,4 +35,23 @@ #undef ENUM_CASE } LLVMSynchronizationScope; +#define LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(macro) \+ macro(UnsafeAlgebra, unsafeAlgebra) \+ macro(NoNaNs, noNaNs) \+ macro(NoInfs, noInfs) \+ macro(NoSignedZeros, noSignedZeros) \+ macro(AllowReciprocal, allowReciprocal)++typedef enum {+#define ENUM_CASE(x,l) LLVM ## x ## Bit,+LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE)+#undef ENUM_CASE+} LLVMFastMathFlagBit;++typedef enum {+#define ENUM_CASE(x,l) LLVM ## x = (1 << LLVM ## x ## Bit),+LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE)+#undef ENUM_CASE+} LLVMFastMathFlags;+ #endif
src/LLVM/General/Internal/FFI/InstructionC.cpp view
@@ -43,8 +43,16 @@ } } +LLVMFastMathFlags wrap(FastMathFlags f) {+ unsigned r = 0;+#define ENUM_CASE(u,l) if (f.l()) r |= unsigned(LLVM ## u);+LLVM_GENERAL_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE)+#undef ENUM_CASE+ return LLVMFastMathFlags(r); } +}+ extern "C" { unsigned LLVM_General_GetInstructionDefOpcode(LLVMValueRef val) {@@ -61,6 +69,10 @@ int LLVM_General_IsExact(LLVMValueRef val) { return unwrap<PossiblyExactOperator>(val)->isExact();+}++LLVMFastMathFlags LLVM_General_GetFastMathFlags(LLVMValueRef val) {+ return wrap(unwrap<Instruction>(val)->getFastMathFlags()); } LLVMValueRef LLVM_General_GetCallInstCalledValue(
src/LLVM/General/Internal/FFI/LLVMCTypes.hsc view
@@ -106,6 +106,11 @@ newtype MDKindID = MDKindID CUInt deriving (Storable) +newtype FastMathFlags = FastMathFlags CUInt+ deriving (Eq, Ord, Show, Typeable, Data, Num, Bits)+#define FMF_Rec(n,l) { #n, LLVM ## n, },+#{inject FAST_MATH_FLAG, FastMathFlags, FastMathFlags, fastMathFlags, FMF_Rec}+ newtype MemoryOrdering = MemoryOrdering CUInt deriving (Eq, Typeable, Data) #define MO_Rec(n) { #n, LLVMAtomicOrdering ## n },
src/LLVM/General/Internal/FFI/Value.hs view
@@ -33,5 +33,8 @@ foreign import ccall unsafe "LLVMReplaceAllUsesWith" replaceAllUsesWith :: Ptr Value -> Ptr Value -> IO () +foreign import ccall unsafe "LLVM_General_CreateArgument" createArgument ::+ Ptr Type -> CString -> IO (Ptr Value)+ foreign import ccall unsafe "LLVMDumpValue" dumpValue :: Ptr Value -> IO ()
src/LLVM/General/Internal/FFI/ValueC.cpp view
@@ -1,6 +1,8 @@ #define __STDC_LIMIT_MACROS #include "llvm-c/Core.h"+#include "llvm/IR/Type.h" #include "llvm/IR/Value.h"+#include "llvm/IR/Argument.h" #include "LLVM/General/Internal/FFI/Value.h" using namespace llvm;@@ -15,6 +17,13 @@ default: break; } return LLVMValueSubclassId(0);+}++LLVMValueRef LLVM_General_CreateArgument(+ LLVMTypeRef t,+ const char *name+) {+ return wrap(new Argument(unwrap(t), name)); } }
+ src/LLVM/General/Internal/FastMathFlags.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE + MultiParamTypeClasses+ #-}+module LLVM.General.Internal.FastMathFlags where++import Control.Monad.Trans+import Control.Monad.AnyCont+import Control.Monad.State+import Control.Exception++import Data.Bits++import qualified LLVM.General.Internal.FFI.Builder as FFI+import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI++import LLVM.General.Internal.Coding+import LLVM.General.Internal.EncodeAST++import qualified LLVM.General.AST as A++instance EncodeM IO A.FastMathFlags FFI.FastMathFlags where+ encodeM A.NoFastMathFlags = return 0+ encodeM A.UnsafeAlgebra = return FFI.fastMathFlagsUnsafeAlgebra+ encodeM f = return $ foldr1 (.|.) [ + if a f then b else 0+ | (a,b) <- [+ (A.noNaNs, FFI.fastMathFlagsNoNaNs),+ (A.noInfs, FFI.fastMathFlagsNoInfs),+ (A.noSignedZeros, FFI.fastMathFlagsNoSignedZeros),+ (A.allowReciprocal, FFI.fastMathFlagsAllowReciprocal)+ ] + ]++instance EncodeM EncodeAST A.FastMathFlags () where+ encodeM f = do+ f <- liftIO $ encodeM f+ builder <- gets encodeStateBuilder+ anyContToM $ bracket (FFI.setFastMathFlags builder f) (\() -> FFI.setFastMathFlags builder 0) ++instance Monad m => DecodeM m A.FastMathFlags FFI.FastMathFlags where+ decodeM 0 = return A.NoFastMathFlags+ decodeM f | FFI.fastMathFlagsUnsafeAlgebra .&. f /= 0 = return A.UnsafeAlgebra+ decodeM f = return A.FastMathFlags {+ A.noNaNs = FFI.fastMathFlagsNoNaNs .&. f /= 0,+ A.noInfs = FFI.fastMathFlagsNoInfs .&. f /= 0,+ A.noSignedZeros = FFI.fastMathFlagsNoSignedZeros .&. f /= 0,+ A.allowReciprocal = FFI.fastMathFlagsAllowReciprocal .&. f /= 0+ }+
src/LLVM/General/Internal/Instruction.hs view
@@ -2,7 +2,8 @@ TemplateHaskell, QuasiQuotes, MultiParamTypeClasses,- UndecidableInstances+ UndecidableInstances,+ ViewPatterns #-} module LLVM.General.Internal.Instruction where @@ -37,6 +38,7 @@ import LLVM.General.Internal.Coding import LLVM.General.Internal.DecodeAST import LLVM.General.Internal.EncodeAST+import LLVM.General.Internal.FastMathFlags () import LLVM.General.Internal.Metadata () import LLVM.General.Internal.Operand () import LLVM.General.Internal.RMWOperation ()@@ -237,6 +239,7 @@ get_nsw b = liftIO $ decodeM =<< FFI.hasNoSignedWrap (FFI.upCast b) get_nuw b = liftIO $ decodeM =<< FFI.hasNoUnsignedWrap (FFI.upCast b) get_exact b = liftIO $ decodeM =<< FFI.isExact (FFI.upCast b)+ get_fastMathFlags b = liftIO $ decodeM =<< FFI.getFastMathFlags (FFI.upCast b) n <- liftIO $ FFI.getInstructionDefOpcode i $(@@ -246,6 +249,7 @@ "nsw" -> (["b"], [| get_nsw $(TH.dyn "b") |]) "nuw" -> (["b"], [| get_nuw $(TH.dyn "b") |]) "exact" -> (["b"], [| get_exact $(TH.dyn "b") |])+ "fastMathFlags" -> (["b"], [| get_fastMathFlags $(TH.dyn "b") |]) "operand0" -> ([], [| op 0 |]) "operand1" -> ([], [| op 1 |]) "address" -> ([], case lrn of "Store" -> [| op 1 |]; _ -> [| op 0 |])@@ -339,253 +343,160 @@ builder <- gets encodeStateBuilder let return' i = return (FFI.upCast i, return ()) s <- encodeM ""- (inst, act) <- $(- [|- case o of- A.ICmp { - A.iPredicate = pred,- A.operand0 = op0,- A.operand1 = op1- } -> do- op0' <- encodeM op0- op1' <- encodeM op1- pred <- encodeM pred- i <- liftIO $ FFI.buildICmp builder pred op0' op1' s- return' i- A.FCmp {- A.fpPredicate = pred,- A.operand0 = op0,- A.operand1 = op1- } -> do- op0' <- encodeM op0- op1' <- encodeM op1- pred <- encodeM pred- i <- liftIO $ FFI.buildFCmp builder pred op0' op1' s- return' i- A.Phi { A.type' = t, A.incomingValues = ivs } -> do- t' <- encodeM t- i <- liftIO $ FFI.buildPhi builder t' s- return (- FFI.upCast i,- do- let (ivs3, bs3) = unzip ivs- ivs3' <- encodeM ivs3- bs3' <- encodeM bs3- liftIO $ FFI.addIncoming i ivs3' bs3'- )- A.Call {- A.isTailCall = tc,- A.callingConvention = cc,- A.returnAttributes = rAttrs,- A.function = f,- A.arguments = args,- A.functionAttributes = fAttrs- } -> do- fv <- encodeM f- let (argvs, argAttrs) = unzip args- (n, argvs) <- encodeM argvs- i <- liftIO $ FFI.buildCall builder fv argvs n s- forM (zip (rAttrs : argAttrs) [0..]) $ \(attrs, j) -> do- attrs <- encodeM attrs- liftIO $ FFI.addCallInstAttr i j attrs- fAttrs <- encodeM fAttrs- liftIO $ FFI.addCallInstFunctionAttr i fAttrs- when tc $ do- tc <- encodeM tc- liftIO $ FFI.setTailCall i tc- cc <- encodeM cc- liftIO $ FFI.setInstructionCallConv i cc- return' i- A.Select { A.condition' = c, A.trueValue = t, A.falseValue = f } -> do- c' <- encodeM c- t' <- encodeM t- f' <- encodeM f- i <- liftIO $ FFI.buildSelect builder c' t' f' s- return' i- A.VAArg { A.argList = al, A.type' = t } -> do- al' <- encodeM al- t' <- encodeM t- i <- liftIO $ FFI.buildVAArg builder al' t' s- return' i- A.ExtractElement { A.vector = v, A.index = idx } -> do- v' <- encodeM v- idx' <- encodeM idx- i <- liftIO $ FFI.buildExtractElement builder v' idx' s- return' i- A.InsertElement { A.vector = v, A.element = e, A.index = idx } -> do- v' <- encodeM v- e' <- encodeM e- idx' <- encodeM idx- i <- liftIO $ FFI.buildInsertElement builder v' e' idx' s- return' i- A.ShuffleVector { A.operand0 = o0, A.operand1 = o1, A.mask = mask } -> do- o0' <- encodeM o0- o1' <- encodeM o1- mask' <- encodeM mask- i <- liftIO $ FFI.buildShuffleVector builder o0' o1' mask' s- return' i- A.ExtractValue { A.aggregate = a, A.indices' = is } -> do- a' <- encodeM a- (n, is') <- encodeM is- i <- liftIO $ FFI.buildExtractValue builder a' is' n s- return' i- A.InsertValue { A.aggregate = a, A.element = e, A.indices' = is } -> do- a' <- encodeM a- e' <- encodeM e- (n, is') <- encodeM is- i <- liftIO $ FFI.buildInsertValue builder a' e' is' n s- return' i- A.LandingPad { - A.type' = t,- A.personalityFunction = pf,- A.cleanup = cl, - A.clauses = cs- } -> do- t' <- encodeM t- pf' <- encodeM pf- i <- liftIO $ FFI.buildLandingPad builder t' pf' (fromIntegral $ length cs) s- forM cs $ \c -> - case c of- A.Catch a -> do- cn <- encodeM a- isArray <- liftIO $ isArrayType =<< FFI.typeOf (FFI.upCast cn)- when isArray $ fail $ "Catch clause cannot take an array: " ++ show c- liftIO $ FFI.addClause i cn- A.Filter a -> do- cn <- encodeM a- isArray <- liftIO $ isArrayType =<< FFI.typeOf (FFI.upCast cn)- unless isArray $ fail $ "filter clause must take an array: " ++ show c- liftIO $ FFI.addClause i cn- when cl $ do- cl <- encodeM cl- liftIO $ FFI.setCleanup i cl- return' i- A.Alloca { A.allocatedType = alt, A.numElements = n, A.alignment = alignment } -> do - alt' <- encodeM alt- n' <- maybe (return nullPtr) encodeM n- i <- liftIO $ FFI.buildAlloca builder alt' n' s- unless (alignment == 0) $ liftIO $ FFI.setInstrAlignment i (fromIntegral alignment)- return' i- A.Load {- A.volatile = vol,- A.address = a,- A.alignment = al,- A.maybeAtomicity = mat- } -> do- a' <- encodeM a- al <- encodeM al- vol <- encodeM vol- (ss, mo) <- encodeM mat- i <- liftIO $ FFI.buildLoad builder a' al vol mo ss s- return' i- A.Store { - A.volatile = vol, - A.address = a, - A.value = v, - A.maybeAtomicity = mat, - A.alignment = al- } -> do- a' <- encodeM a- v' <- encodeM v- al <- encodeM al- vol <- encodeM vol- (ss, mo) <- encodeM mat- i <- liftIO $ FFI.buildStore builder v' a' al vol mo ss s- return' i- A.GetElementPtr { A.address = a, A.indices = is, A.inBounds = ib } -> do- a' <- encodeM a- (n, is') <- encodeM is- ib <- encodeM ib - i <- liftIO $ FFI.buildGetElementPtr builder ib a' is' n s- return' i- A.Fence { A.atomicity = at } -> do- (ss, mo) <- encodeM at- i <- liftIO $ FFI.buildFence builder mo ss s- return' i- A.CmpXchg { - A.volatile = vol, - A.address = a, A.expected = e, A.replacement = r,- A.atomicity = at- } -> do- a' <- encodeM a- e' <- encodeM e- r' <- encodeM r- vol <- encodeM vol- (ss, mo) <- encodeM at- i <- liftIO $ FFI.buildCmpXchg builder a' e' r' vol mo ss s- return' i- A.AtomicRMW {- A.volatile = vol,- A.rmwOperation = rmwOp,- A.address = a,- A.value = v,- A.atomicity = at- } -> do- a' <- encodeM a- v' <- encodeM v- rmwOp <- encodeM rmwOp- vol <- encodeM vol- (ss, mo) <- encodeM at- i <- liftIO $ FFI.buildAtomicRMW builder rmwOp a' v' vol mo ss s- return' i- o -> $(- let- fieldData :: String -> [Either TH.ExpQ TH.ExpQ]- fieldData s = case s of- "operand0" -> [Left [| encodeM $(TH.dyn s) |] ]- "operand1" -> [Left [| encodeM $(TH.dyn s) |] ]- "type'" -> [Left [| encodeM $(TH.dyn s) |] ]- "nsw" -> [Left [| encodeM $(TH.dyn s) |] ]- "nuw" -> [Left [| encodeM $(TH.dyn s) |] ]- "exact" -> [Left [| encodeM $(TH.dyn s) |] ]- "metadata" -> [Right [| return () |] ]- _ -> error $ "unhandled instruction field " ++ show s- in- TH.caseE [| o |] [- TH.match - (TH.recP fullName [ (f,) <$> (TH.varP . TH.mkName . TH.nameBase $ f) | f <- fieldNames ])- (TH.normalB (TH.doE handlerBody))- []- |- (name, ID.InstructionDef { ID.instructionKind = k }) <- Map.toList ID.instructionDefs,- k `List.elem` [ID.Binary, ID.Cast],- let- TH.RecC fullName fields = findInstrFields name- (fieldNames, _, _) = unzip3 fields- cTorFields = [- (s, binding)- | f <- fieldNames,- let s = TH.nameBase f,- Left binding <- fieldData s- ]- handlerBody = (- [ TH.bindS (TH.varP (TH.mkName s)) binding | (s, binding) <- cTorFields ]- ++ [- TH.bindS - (TH.varP (TH.mkName "i"))- [| liftIO $ $(foldl1 TH.appE . map TH.dyn $ [ - "FFI.build" ++ name,- "builder"- ] ++ [- s | (s, _) <- cTorFields, s /= "metadata"- ] ++ [- "s"- ] ) |]-- ] ++ [- TH.noBindS action- | f <- fieldNames,- let s = TH.nameBase f,- Right action <- fieldData s- ] ++ [- TH.noBindS [| return' $(TH.dyn "i") |]- ]- )- ]- )+ (inst, act) <- case o of+ A.ICmp { + A.iPredicate = pred,+ A.operand0 = op0,+ A.operand1 = op1+ } -> do+ op0' <- encodeM op0+ op1' <- encodeM op1+ pred <- encodeM pred+ i <- liftIO $ FFI.buildICmp builder pred op0' op1' s+ return' i+ A.FCmp {+ A.fpPredicate = pred,+ A.operand0 = op0,+ A.operand1 = op1+ } -> do+ op0' <- encodeM op0+ op1' <- encodeM op1+ pred <- encodeM pred+ i <- liftIO $ FFI.buildFCmp builder pred op0' op1' s+ return' i+ A.Phi { A.type' = t, A.incomingValues = ivs } -> do+ t' <- encodeM t+ i <- liftIO $ FFI.buildPhi builder t' s+ return (+ FFI.upCast i,+ do+ let (ivs3, bs3) = unzip ivs+ ivs3' <- encodeM ivs3+ bs3' <- encodeM bs3+ liftIO $ FFI.addIncoming i ivs3' bs3'+ )+ A.Call {+ A.isTailCall = tc,+ A.callingConvention = cc,+ A.returnAttributes = rAttrs,+ A.function = f,+ A.arguments = args,+ A.functionAttributes = fAttrs+ } -> do+ fv <- encodeM f+ let (argvs, argAttrs) = unzip args+ (n, argvs) <- encodeM argvs+ i <- liftIO $ FFI.buildCall builder fv argvs n s+ forM (zip (rAttrs : argAttrs) [0..]) $ \(attrs, j) -> do+ attrs <- encodeM attrs+ liftIO $ FFI.addCallInstAttr i j attrs+ fAttrs <- encodeM fAttrs+ liftIO $ FFI.addCallInstFunctionAttr i fAttrs+ when tc $ do+ tc <- encodeM tc+ liftIO $ FFI.setTailCall i tc+ cc <- encodeM cc+ liftIO $ FFI.setInstructionCallConv i cc+ return' i+ A.Select { A.condition' = c, A.trueValue = t, A.falseValue = f } -> do+ c' <- encodeM c+ t' <- encodeM t+ f' <- encodeM f+ i <- liftIO $ FFI.buildSelect builder c' t' f' s+ return' i+ A.VAArg { A.argList = al, A.type' = t } -> do+ al' <- encodeM al+ t' <- encodeM t+ i <- liftIO $ FFI.buildVAArg builder al' t' s+ return' i+ A.ExtractElement { A.vector = v, A.index = idx } -> do+ v' <- encodeM v+ idx' <- encodeM idx+ i <- liftIO $ FFI.buildExtractElement builder v' idx' s+ return' i+ A.InsertElement { A.vector = v, A.element = e, A.index = idx } -> do+ v' <- encodeM v+ e' <- encodeM e+ idx' <- encodeM idx+ i <- liftIO $ FFI.buildInsertElement builder v' e' idx' s+ return' i+ A.ShuffleVector { A.operand0 = o0, A.operand1 = o1, A.mask = mask } -> do+ o0' <- encodeM o0+ o1' <- encodeM o1+ mask' <- encodeM mask+ i <- liftIO $ FFI.buildShuffleVector builder o0' o1' mask' s+ return' i+ A.ExtractValue { A.aggregate = a, A.indices' = is } -> do+ a' <- encodeM a+ (n, is') <- encodeM is+ i <- liftIO $ FFI.buildExtractValue builder a' is' n s+ return' i+ A.InsertValue { A.aggregate = a, A.element = e, A.indices' = is } -> do+ a' <- encodeM a+ e' <- encodeM e+ (n, is') <- encodeM is+ i <- liftIO $ FFI.buildInsertValue builder a' e' is' n s+ return' i+ A.LandingPad { + A.type' = t,+ A.personalityFunction = pf,+ A.cleanup = cl, + A.clauses = cs+ } -> do+ t' <- encodeM t+ pf' <- encodeM pf+ i <- liftIO $ FFI.buildLandingPad builder t' pf' (fromIntegral $ length cs) s+ forM cs $ \c -> + case c of+ A.Catch a -> do+ cn <- encodeM a+ isArray <- liftIO $ isArrayType =<< FFI.typeOf (FFI.upCast cn)+ when isArray $ fail $ "Catch clause cannot take an array: " ++ show c+ liftIO $ FFI.addClause i cn+ A.Filter a -> do+ cn <- encodeM a+ isArray <- liftIO $ isArrayType =<< FFI.typeOf (FFI.upCast cn)+ unless isArray $ fail $ "filter clause must take an array: " ++ show c+ liftIO $ FFI.addClause i cn+ when cl $ do+ cl <- encodeM cl+ liftIO $ FFI.setCleanup i cl+ return' i+ A.Alloca { A.allocatedType = alt, A.numElements = n, A.alignment = alignment } -> do + alt' <- encodeM alt+ n' <- encodeM n+ i <- liftIO $ FFI.buildAlloca builder alt' n' s+ unless (alignment == 0) $ liftIO $ FFI.setInstrAlignment i (fromIntegral alignment)+ return' i+ o -> $(TH.caseE [| o |] [+ TH.match + (TH.recP fullName [ (f,) <$> (TH.varP . TH.mkName . TH.nameBase $ f) | f <- fieldNames ])+ (TH.normalB (TH.doE handlerBody))+ []+ |+ (name, ID.instructionKind -> k) <- Map.toList ID.instructionDefs,+ case (k, name) of+ (ID.Binary, _) -> True+ (ID.Cast, _) -> True+ (ID.Memory, "Alloca") -> False+ (ID.Memory, _) -> True+ _ -> False,+ let+ TH.RecC fullName (unzip3 -> (fieldNames, _, _)) = findInstrFields name+ encodeMFields = map TH.nameBase fieldNames List.\\ [ "metadata" ]+ handlerBody = ([+ TH.bindS (if s == "fastMathFlags" then TH.tupP [] else TH.varP (TH.mkName s))+ [| encodeM $(TH.dyn s) |] | s <- encodeMFields + ] ++ [+ TH.bindS (TH.varP (TH.mkName "i")) [| liftIO $ $(+ foldl1 TH.appE . map TH.dyn $ + [ "FFI.build" ++ name, "builder" ] ++ (encodeMFields List.\\ [ "fastMathFlags" ]) ++ [ "s" ] + ) |],+ TH.noBindS [| return' $(TH.dyn "i") |]+ ])+ ]+ ) - |]- ) setMD inst (A.metadata o) return (inst, act) |]
src/LLVM/General/Internal/Module.hs view
@@ -18,6 +18,7 @@ import Foreign.C import Data.IORef import qualified Data.ByteString as BS+import qualified Data.Map as Map import qualified LLVM.General.Internal.FFI.Assembly as FFI import qualified LLVM.General.Internal.FFI.Builder as FFI@@ -315,6 +316,8 @@ (encodeM term :: EncodeAST (Ptr FFI.Instruction)) return (sequence_ finishes) sequence_ finishInstrs+ locals <- gets $ Map.toList . encodeStateLocals+ forM [ n | (n, ForwardValue _) <- locals ] $ \n -> failAsUndefined "local" n return (FFI.upCast f) return $ do g' <- eg'
src/LLVM/General/Internal/Operand.hs view
@@ -6,6 +6,7 @@ import Data.Functor import Control.Monad.State import Control.Monad.AnyCont+import qualified Data.Map as Map import Foreign.Ptr @@ -13,6 +14,7 @@ import qualified LLVM.General.Internal.FFI.InlineAssembly as FFI import qualified LLVM.General.Internal.FFI.Metadata as FFI import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.General.Internal.FFI.Value as FFI import LLVM.General.Internal.Coding import LLVM.General.Internal.Constant ()@@ -41,7 +43,9 @@ if mdn /= nullPtr then return A.MetadataNodeOperand `ap` decodeM mdn else- return A.LocalReference `ap` getLocalName v+ return A.LocalReference + `ap` (decodeM =<< (liftIO $ FFI.typeOf v))+ `ap` getLocalName v instance DecodeM DecodeAST A.CallableOperand (Ptr FFI.Value) where decodeM v = do@@ -52,7 +56,17 @@ instance EncodeM EncodeAST A.Operand (Ptr FFI.Value) where encodeM (A.ConstantOperand c) = (FFI.upCast :: Ptr FFI.Constant -> Ptr FFI.Value) <$> encodeM c- encodeM (A.LocalReference n) = referLocal n+ encodeM (A.LocalReference t n) = do+ lv <- refer encodeStateLocals n $ do+ lv <- do+ n <- encodeM n+ t <- encodeM t+ v <- liftIO $ FFI.createArgument t n+ return $ ForwardValue v+ modify $ \s -> s { encodeStateLocals = Map.insert n lv $ encodeStateLocals s }+ return lv+ return $ case lv of DefinedValue v -> v; ForwardValue v -> v+ encodeM (A.MetadataStringOperand s) = do Context c <- gets encodeStateContext s <- encodeM s
test/LLVM/General/Test/Analysis.hs view
@@ -13,7 +13,7 @@ import LLVM.General.Analysis import LLVM.General.AST as A-import LLVM.General.AST.Type+import LLVM.General.AST.Type as A.T import LLVM.General.AST.Name import LLVM.General.AST.AddrSpace import LLVM.General.AST.DataLayout@@ -35,8 +35,8 @@ -- this test will cause an assertion if LLVM is compiled with assertions on. testCase "Module" $ do let ast = Module "<string>" Nothing Nothing [- GlobalDefinition $ Function L.External V.Default CC.C [] VoidType (Name "foo") ([- Parameter (IntegerType 32) (Name "x") []+ GlobalDefinition $ Function L.External V.Default CC.C [] A.T.void (Name "foo") ([+ Parameter i32 (Name "x") [] ],False) [] Nothing 0 @@ -79,28 +79,28 @@ ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = FloatingPointType 64 IEEE,+ G.returnType = double, G.name = Name "my_function2", G.parameters = ([- Parameter (PointerType (FloatingPointType 64 IEEE) (AddrSpace 0)) (Name "input_0") []+ Parameter (ptr double) (Name "input_0") [] ],False), G.basicBlocks = [ BasicBlock (Name "foo") [ Name "tmp_input_w0" := GetElementPtr { inBounds = True,- address = LocalReference (Name "input_0"),+ address = LocalReference (ptr double) (Name "input_0"), indices = [ConstantOperand (C.Int 64 0)], metadata = [] }, UnName 0 := Load { volatile = False,- address = LocalReference (Name "tmp_input_w0"),+ address = LocalReference (ptr double) (Name "tmp_input_w0"), maybeAtomicity = Nothing, alignment = 8, metadata = [] } ] (- Do $ Ret (Just (LocalReference (UnName 0))) []+ Do $ Ret (Just (LocalReference double (UnName 0))) [] ) ] }
test/LLVM/General/Test/Constants.hs view
@@ -33,7 +33,7 @@ | (name, type', value, str) <- [ ( "integer",- IntegerType 32,+ i32, C.Int 32 1, "global i32 1" ), (@@ -53,111 +53,111 @@ "global i65 -1" ), ( "half",- FloatingPointType 16 IEEE,+ half, C.Float (F.Half 0x1234), "global half 0xH1234" ), ( "float",- FloatingPointType 32 IEEE,+ float, C.Float (F.Single 1), "global float 1.000000e+00" ), ( "double",- FloatingPointType 64 IEEE,+ double, C.Float (F.Double 1), "global double 1.000000e+00" ), ( "quad",- FloatingPointType 128 IEEE,+ fp128, C.Float (F.Quadruple 0x0007000600050004 0x0003000200010000), "global fp128 0xL00030002000100000007000600050004" -- yes, this order is weird ), ( "quad 1.0",- FloatingPointType 128 IEEE,+ fp128, C.Float (F.Quadruple 0x3fff000000000000 0x0000000000000000), "global fp128 0xL00000000000000003FFF000000000000" -- yes, this order is weird ), ( "x86_fp80",- FloatingPointType 80 DoubleExtended,+ x86_fp80, C.Float (F.X86_FP80 0x0004 0x0003000200010000), "global x86_fp80 0xK00040003000200010000" {- don't know how to test this - LLVM's handling of this weird type is even weirder ), ( "ppc_fp128",- FloatingPointType 128 PairOfFloats,+ ppc_fp128, C.Float (F.PPC_FP128 0x0007000600050004 0x0003000200010000), "global ppc_fp128 0xM????????????????" -} ), ( "struct",- StructureType False (replicate 2 (IntegerType 32)),+ StructureType False (replicate 2 i32), C.Struct Nothing False (replicate 2 (C.Int 32 1)), "global { i32, i32 } { i32 1, i32 1 }" ), ( "dataarray",- ArrayType 3 (IntegerType 32),- C.Array (IntegerType 32) [C.Int 32 i | i <- [1,2,1]],+ ArrayType 3 i32,+ C.Array i32 [C.Int 32 i | i <- [1,2,1]], "global [3 x i32] [i32 1, i32 2, i32 1]" ), ( "array",- ArrayType 3 (StructureType False [IntegerType 32]),- C.Array (StructureType False [IntegerType 32]) [C.Struct Nothing False [C.Int 32 i] | i <- [1,2,1]],+ ArrayType 3 (StructureType False [i32]),+ C.Array (StructureType False [i32]) [C.Struct Nothing False [C.Int 32 i] | i <- [1,2,1]], "global [3 x { i32 }] [{ i32 } { i32 1 }, { i32 } { i32 2 }, { i32 } { i32 1 }]" ), ( "datavector",- VectorType 3 (IntegerType 32),+ VectorType 3 i32, C.Vector [C.Int 32 i | i <- [1,2,1]], "global <3 x i32> <i32 1, i32 2, i32 1>" ), ( "undef",- IntegerType 32,- C.Undef (IntegerType 32),+ i32,+ C.Undef i32, "global i32 undef" ), ( "binop/cast",- IntegerType 64,- C.Add False False (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64)) (C.Int 64 2),+ i64,+ C.Add False False (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i64) (C.Int 64 2), "global i64 add (i64 ptrtoint (i32* @1 to i64), i64 2)" ), ( "binop/cast nsw",- IntegerType 64,- C.Add True False (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64)) (C.Int 64 2),+ i64,+ C.Add True False (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i64) (C.Int 64 2), "global i64 add nsw (i64 ptrtoint (i32* @1 to i64), i64 2)" ), ( "icmp",- IntegerType 1,- C.ICmp IPred.SGE (C.GlobalReference (UnName 1)) (C.GlobalReference (UnName 2)),+ i1,+ C.ICmp IPred.SGE (C.GlobalReference (ptr i32) (UnName 1)) (C.GlobalReference (ptr i32) (UnName 2)), "global i1 icmp sge (i32* @1, i32* @2)" ), ( "getelementptr",- PointerType (IntegerType 32) (AddrSpace 0),- C.GetElementPtr True (C.GlobalReference (UnName 1)) [C.Int 64 27],+ ptr i32,+ C.GetElementPtr True (C.GlobalReference (ptr i32) (UnName 1)) [C.Int 64 27], "global i32* getelementptr inbounds (i32* @1, i64 27)" ), ( "selectvalue",- IntegerType 32,- C.Select (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 1)) + i32,+ C.Select (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i1) (C.Int 32 1) (C.Int 32 2), "global i32 select (i1 ptrtoint (i32* @1 to i1), i32 1, i32 2)" ), ( "extractelement",- IntegerType 32,+ i32, C.ExtractElement (C.BitCast- (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 64))- (VectorType 2 (IntegerType 32)))+ (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i64)+ (VectorType 2 i32)) (C.Int 32 1), "global i32 extractelement (<2 x i32> bitcast (i64 ptrtoint (i32* @1 to i64) to <2 x i32>), i32 1)" {- ), ( -- This test made llvm abort as of llvm-3.2. Now, as a new feature in llvm-3.4, it makes it report a fatal error! "extractvalue",- IntegerType 8,+ i8, C.ExtractValue- (C.Select (C.PtrToInt (C.GlobalReference (UnName 1)) (IntegerType 1)) - (C.Array (IntegerType 8) [C.Int 8 0])- (C.Array (IntegerType 8) [C.Int 8 1]))+ (C.Select (C.PtrToInt (C.GlobalReference (p i32) (UnName 1)) i1) + (C.Array i8 [C.Int 8 0])+ (C.Array i8 [C.Int 8 1])) [0], "global i8 extractvalue ([1 x i8] select (i1 ptrtoint (i32* @1 to i1), [1 x i8] [ i8 1 ], [1 x i8] [ i8 2 ]), 0)" -}@@ -168,10 +168,10 @@ G.name = UnName 0, G.type' = type', G.initializer = Just value }, GlobalDefinition $ globalVariableDefaults {- G.name = UnName 1, G.type' = IntegerType 32, G.initializer = Nothing + G.name = UnName 1, G.type' = i32, G.initializer = Nothing }, GlobalDefinition $ globalVariableDefaults {- G.name = UnName 2, G.type' = IntegerType 32, G.initializer = Nothing + G.name = UnName 2, G.type' = i32, G.initializer = Nothing } ] mStr = "; ModuleID = '<string>'\n\n@0 = " ++ str ++ "\n\
test/LLVM/General/Test/ExecutionEngine.hs view
@@ -38,9 +38,9 @@ testJIT withEE = withContext $ \context -> withEE context $ \executionEngine -> do let mAST = Module "runSomethingModule" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "_foo",- G.parameters = ([Parameter (IntegerType 32) (Name "bar") []],False),+ G.parameters = ([Parameter i32 (Name "bar") []],False), G.basicBlocks = [ BasicBlock (UnName 0) [] ( Do $ Ret (Just (ConstantOperand (C.Int 32 42))) []
test/LLVM/General/Test/Global.hs view
@@ -9,6 +9,7 @@ import LLVM.General.Context import LLVM.General.Module import LLVM.General.AST+import LLVM.General.AST.Type as A.T import qualified LLVM.General.AST.Global as G tests = testGroup "Global" [@@ -22,12 +23,12 @@ g <- [ globalVariableDefaults { G.name = UnName 0,- G.type' = IntegerType 32,+ G.type' = i32, G.alignment = a, G.section = s }, functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.parameters = ([], False), G.alignment = a,
test/LLVM/General/Test/InlineAssembly.hs view
@@ -10,6 +10,7 @@ import LLVM.General.Module import LLVM.General.AST+import LLVM.General.AST.Type import LLVM.General.AST.InlineAssembly as IA import qualified LLVM.General.AST.Linkage as L import qualified LLVM.General.AST.Visibility as V@@ -22,9 +23,9 @@ let ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []],False),+ G.parameters = ([Parameter i32 (Name "x") []],False), G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Call {@@ -32,7 +33,7 @@ callingConvention = CC.C, returnAttributes = [], function = Left $ InlineAssembly {- IA.type' = FunctionType (IntegerType 32) [IntegerType 32] False,+ IA.type' = FunctionType i32 [i32] False, assembly = "bswap $0", constraints = "=r,r", hasSideEffects = False,@@ -40,13 +41,13 @@ dialect = ATTDialect }, arguments = [- (LocalReference (Name "x"), [])+ (LocalReference i32 (Name "x"), []) ], functionAttributes = [], metadata = [] } ] (- Do $ Ret (Just (LocalReference (UnName 1))) []+ Do $ Ret (Just (LocalReference i32 (UnName 1))) [] ) ] }@@ -66,7 +67,7 @@ ModuleInlineAssembly "bar", GlobalDefinition $ globalVariableDefaults { G.name = UnName 0,- G.type' = IntegerType 32+ G.type' = i32 } ] s = "; ModuleID = '<string>'\n\
test/LLVM/General/Test/Instructions.hs view
@@ -16,7 +16,7 @@ import LLVM.General.Module import LLVM.General.Diagnostic import LLVM.General.AST-import LLVM.General.AST.Type+import LLVM.General.AST.Type as A.T import LLVM.General.AST.Name import LLVM.General.AST.AddrSpace import qualified LLVM.General.AST.IntegerPredicate as IPred@@ -34,17 +34,9 @@ testCase name $ do let mAST = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0,- G.parameters = ([- Parameter (IntegerType 32) (UnName 0) [],- Parameter (FloatingPointType 32 IEEE) (UnName 1) [],- Parameter (PointerType (IntegerType 32) (AddrSpace 0)) (UnName 2) [],- Parameter (IntegerType 64) (UnName 3) [],- Parameter (IntegerType 1) (UnName 4) [],- Parameter (VectorType 2 (IntegerType 32)) (UnName 5) [],- Parameter (StructureType False [IntegerType 32, IntegerType 32]) (UnName 6) []- ], False),+ G.parameters = ([Parameter t (UnName n) [] | (t,n) <- zip ts [0..]], False), G.basicBlocks = [ BasicBlock (UnName 7) [ namedInstr@@ -61,7 +53,16 @@ \ ret void\n\ \}\n" strCheck mAST mStr- | let a = LocalReference . UnName,+ | let ts = [+ i32,+ float,+ ptr i32,+ i64,+ i1,+ VectorType 2 i32,+ StructureType False [i32, i32]+ ],+ let a i = LocalReference (ts !! fromIntegral i) (UnName i), (name, namedInstr, namedInstrS) <- ( [ (name, UnName 8 := instr, "%8 = " ++ instrS)@@ -95,6 +96,7 @@ "add nuw i32 %0, %0"), ("fadd", FAdd {+ fastMathFlags = NoFastMathFlags, operand0 = a 1, operand1 = a 1, metadata = [] @@ -111,6 +113,7 @@ "sub i32 %0, %0"), ("fsub", FSub {+ fastMathFlags = NoFastMathFlags, operand0 = a 1, operand1 = a 1, metadata = [] @@ -127,6 +130,7 @@ "mul i32 %0, %0"), ("fmul", FMul {+ fastMathFlags = NoFastMathFlags, operand0 = a 1, operand1 = a 1, metadata = [] @@ -158,6 +162,7 @@ "sdiv i32 %0, %0"), ("fdiv", FDiv {+ fastMathFlags = NoFastMathFlags, operand0 = a 1, operand1 = a 1, metadata = [] @@ -179,11 +184,20 @@ "srem i32 %0, %0"), ("frem", FRem {+ fastMathFlags = NoFastMathFlags, operand0 = a 1, operand1 = a 1, metadata = [] }, "frem float %1, %1"),+ ("frem fast",+ FRem {+ fastMathFlags = UnsafeAlgebra,+ operand0 = a 1,+ operand1 = a 1,+ metadata = [] + },+ "frem fast float %1, %1"), ("shl", Shl { nsw = False,@@ -232,7 +246,7 @@ "xor i32 %0, %0"), ("alloca", Alloca {- allocatedType = IntegerType 32,+ allocatedType = i32, numElements = Nothing, alignment = 0, metadata = [] @@ -322,91 +336,91 @@ ("trunc", Trunc { operand0 = a 0,- type' = IntegerType 16,+ type' = i16, metadata = [] }, "trunc i32 %0 to i16"), ("zext", ZExt { operand0 = a 0,- type' = IntegerType 64,+ type' = i64, metadata = [] }, "zext i32 %0 to i64"), ("sext", SExt { operand0 = a 0,- type' = IntegerType 64,+ type' = i64, metadata = [] }, "sext i32 %0 to i64"), ("fptoui", FPToUI { operand0 = a 1,- type' = IntegerType 64,+ type' = i64, metadata = [] }, "fptoui float %1 to i64"), ("fptosi", FPToSI { operand0 = a 1,- type' = IntegerType 64,+ type' = i64, metadata = [] }, "fptosi float %1 to i64"), ("uitofp", UIToFP { operand0 = a 0,- type' = FloatingPointType 32 IEEE,+ type' = float, metadata = [] }, "uitofp i32 %0 to float"), ("sitofp", SIToFP { operand0 = a 0,- type' = FloatingPointType 32 IEEE,+ type' = float, metadata = [] }, "sitofp i32 %0 to float"), ("fptrunc", FPTrunc { operand0 = a 1,- type' = FloatingPointType 16 IEEE,+ type' = half, metadata = [] }, "fptrunc float %1 to half"), ("fpext", FPExt { operand0 = a 1,- type' = FloatingPointType 64 IEEE,+ type' = double, metadata = [] }, "fpext float %1 to double"), ("ptrtoint", PtrToInt { operand0 = a 2,- type' = IntegerType 32,+ type' = i32, metadata = [] }, "ptrtoint i32* %2 to i32"), ("inttoptr", IntToPtr { operand0 = a 0,- type' = PointerType (IntegerType 32) (AddrSpace 0),+ type' = ptr i32, metadata = [] }, "inttoptr i32 %0 to i32*"), ("bitcast", BitCast { operand0 = a 0,- type' = FloatingPointType 32 IEEE,+ type' = float, metadata = [] }, "bitcast i32 %0 to float"), ("addrspacecast", AddrSpaceCast { operand0 = a 2,- type' = PointerType (IntegerType 32) (AddrSpace 2),+ type' = PointerType i32 (AddrSpace 2), metadata = [] }, "addrspacecast i32* %2 to i32 addrspace(2)*"),@@ -421,7 +435,7 @@ ("vaarg", VAArg { argList = a 2,- type' = IntegerType 16,+ type' = i16, metadata = [] }, "va_arg i32* %2, i16"),@@ -467,10 +481,10 @@ ("landingpad-" ++ n, LandingPad { type' = StructureType False [ - PointerType (IntegerType 8) (AddrSpace 0),- IntegerType 32+ ptr i8,+ i32 ],- personalityFunction = ConstantOperand (C.GlobalReference (UnName 0)),+ personalityFunction = ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void ts False)) (UnName 0)), cleanup = cp, clauses = cls, metadata = []@@ -478,10 +492,10 @@ "landingpad { i8*, i32 } personality void (i32, float, i32*, i64, i1, <2 x i32>, { i32, i32 })* @0" ++ s) | (clsn,cls,clss) <- [ ("catch",- [Catch (C.Null (PointerType (IntegerType 8) (AddrSpace 0)))],+ [Catch (C.Null (ptr i8))], "\n catch i8* null"), ("filter",- [Filter (C.Null (ArrayType 1 (PointerType (IntegerType 8) (AddrSpace 0))))],+ [Filter (C.Null (ArrayType 1 (ptr i8)))], "\n filter [1 x i8*] zeroinitializer") ], (cpn, cp, cps) <- [ ("-cleanup", True, "\n cleanup"), ("", False, "") ],@@ -548,8 +562,8 @@ isTailCall = False, callingConvention = CC.C, returnAttributes = [],- function = Right (ConstantOperand (C.GlobalReference (UnName 0))),- arguments = [ (LocalReference (UnName i), []) | i <- [0..6] ],+ function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void ts False)) (UnName 0))),+ arguments = [ (a i, []) | i <- [0..6] ], functionAttributes = [], metadata = [] },@@ -561,30 +575,30 @@ let mAST = Module "<string>" Nothing Nothing [ GlobalDefinition $ globalVariableDefaults { G.name = Name "fortytwo",- G.type' = IntegerType 32,+ G.type' = i32, G.isConstant = True, G.initializer = Just $ C.Int 32 42 }, GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = UnName 0, G.basicBlocks = [ BasicBlock (UnName 1) [ UnName 2 := GetElementPtr { inBounds = True,- address = ConstantOperand (C.GlobalReference (Name "fortytwo")),+ address = ConstantOperand (C.GlobalReference (ptr i32) (Name "fortytwo")), indices = [ ConstantOperand (C.Int 32 0) ], metadata = [] }, UnName 3 := Load { volatile = False,- address = LocalReference (UnName 2),+ address = LocalReference (ptr i32) (UnName 2), maybeAtomicity = Nothing, alignment = 1, metadata = [] } ] (- Do $ Ret (Just (LocalReference (UnName 3))) []+ Do $ Ret (Just (LocalReference i32 (UnName 3))) [] ) ] }@@ -607,7 +621,7 @@ "ret", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.basicBlocks = [ BasicBlock (UnName 0) [@@ -626,7 +640,7 @@ "br", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.basicBlocks = [ BasicBlock (UnName 0) [] (@@ -650,7 +664,7 @@ "condbr", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.basicBlocks = [ BasicBlock (Name "bar") [] (@@ -675,7 +689,7 @@ "switch", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.basicBlocks = [ BasicBlock (UnName 0) [] (@@ -714,24 +728,24 @@ Module "<string>" Nothing Nothing [ GlobalDefinition $ globalVariableDefaults { G.name = UnName 0,- G.type' = PointerType (IntegerType 8) (AddrSpace 0),+ G.type' = ptr i8, G.initializer = Just (C.BlockAddress (Name "foo") (UnName 2)) }, GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = Name "foo", G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Load { volatile = False,- address = ConstantOperand (C.GlobalReference (UnName 0)),+ address = ConstantOperand (C.GlobalReference (ptr (ptr i8)) (UnName 0)), maybeAtomicity = Nothing, alignment = 0, metadata = [] } ] ( Do $ IndirectBr {- operand0' = LocalReference (UnName 1),+ operand0' = LocalReference (ptr i8) (UnName 1), possibleDests = [UnName 2], metadata' = [] }@@ -758,18 +772,18 @@ "invoke", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.parameters = ([- Parameter (IntegerType 32) (UnName 0) [],- Parameter (IntegerType 16) (UnName 1) []+ Parameter i32 (UnName 0) [],+ Parameter i16 (UnName 1) [] ], False), G.basicBlocks = [ BasicBlock (UnName 2) [] ( Do $ Invoke { callingConvention' = CC.C, returnAttributes' = [],- function' = Right (ConstantOperand (C.GlobalReference (UnName 0))),+ function' = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [i32, i16] False)) (UnName 0))), arguments' = [ (ConstantOperand (C.Int 32 4), []), (ConstantOperand (C.Int 16 8), [])@@ -786,12 +800,12 @@ BasicBlock (Name "bar") [ UnName 3 := LandingPad { type' = StructureType False [ - PointerType (IntegerType 8) (AddrSpace 0),- IntegerType 32+ ptr i8,+ i32 ],- personalityFunction = ConstantOperand (C.GlobalReference (UnName 0)),+ personalityFunction = ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [i32, i16] False)) (UnName 0)), cleanup = True,- clauses = [Catch (C.Null (PointerType (IntegerType 8) (AddrSpace 0)))],+ clauses = [Catch (C.Null (ptr i8))], metadata = [] } ] (@@ -819,7 +833,7 @@ "resume", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.basicBlocks = [ BasicBlock (UnName 0) [] (@@ -837,7 +851,7 @@ "unreachable", Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = UnName 0, G.basicBlocks = [ BasicBlock (UnName 0) [] (
test/LLVM/General/Test/Instrumentation.hs view
@@ -40,63 +40,74 @@ dl <- withDefaultTargetMachine getTargetMachineDataLayout return $ Module "<string>" (Just dl) Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 128) (Name "x") []],False),+ G.parameters = ([Parameter i128 (Name "x") []],False), G.basicBlocks = [ BasicBlock (UnName 0) [] (Do $ Br (Name "checkDone") []), BasicBlock (Name "checkDone") [ UnName 1 := Phi {- type' = IntegerType 128,+ type' = i128, incomingValues = [- (LocalReference (Name "x"), UnName 0),- (LocalReference (Name "x'"), Name "even"),- (LocalReference (Name "x''"), Name "odd")+ (LocalReference i128 (Name "x"), UnName 0),+ (LocalReference i128 (Name "x'"), Name "even"),+ (LocalReference i128 (Name "x''"), Name "odd") ], metadata = [] }, Name "count" := Phi {- type' = IntegerType 32,+ type' = i32, incomingValues = [ (ConstantOperand (C.Int 32 1), UnName 0),- (LocalReference (Name "count'"), Name "even"),- (LocalReference (Name "count'"), Name "odd")+ (LocalReference i32 (Name "count'"), Name "even"),+ (LocalReference i32 (Name "count'"), Name "odd") ], metadata = [] },- Name "count'" := Add False False (LocalReference (Name "count")) (ConstantOperand (C.Int 32 1)) [],- Name "is one" := ICmp IPred.EQ (LocalReference (UnName 1)) (ConstantOperand (C.Int 128 1)) []+ Name "count'" := Add {+ nsw = False,+ nuw = False,+ operand0 = LocalReference i32 (Name "count"),+ operand1 = ConstantOperand (C.Int 32 1),+ metadata = []+ },+ Name "is one" := ICmp {+ iPredicate = IPred.EQ,+ operand0 = LocalReference i128 (UnName 1),+ operand1 = ConstantOperand (C.Int 128 1),+ metadata = []+ } ] (- Do $ CondBr (LocalReference (Name "is one")) (Name "done") (Name "checkOdd") []+ Do $ CondBr (LocalReference i1 (Name "is one")) (Name "done") (Name "checkOdd") [] ), BasicBlock (Name "checkOdd") [- Name "is odd" := Trunc (LocalReference (UnName 1)) (IntegerType 1) []+ Name "is odd" := Trunc (LocalReference i128 (UnName 1)) i1 [] ] (- Do $ CondBr (LocalReference (Name "is odd")) (Name "odd") (Name "even") []+ Do $ CondBr (LocalReference i1 (Name "is odd")) (Name "odd") (Name "even") [] ), BasicBlock (Name "even") [- Name "x'" := UDiv True (LocalReference (UnName 1)) (ConstantOperand (C.Int 128 2)) []+ Name "x'" := UDiv True (LocalReference i128 (UnName 1)) (ConstantOperand (C.Int 128 2)) [] ] ( Do $ Br (Name "checkDone") [] ), BasicBlock (Name "odd") [- UnName 2 := Mul False False (LocalReference (UnName 1)) (ConstantOperand (C.Int 128 3)) [],- Name "x''" := Add False False (LocalReference (UnName 2)) (ConstantOperand (C.Int 128 1)) []+ UnName 2 := Mul False False (LocalReference i128 (UnName 1)) (ConstantOperand (C.Int 128 3)) [],+ Name "x''" := Add False False (LocalReference i128 (UnName 2)) (ConstantOperand (C.Int 128 1)) [] ] ( Do $ Br (Name "checkDone") [] ), BasicBlock (Name "done") [ ] (- Do $ Ret (Just (LocalReference (Name "count'"))) []+ Do $ Ret (Just (LocalReference i32 (Name "count'"))) [] ) ] }, GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "main", G.parameters = ([- Parameter (IntegerType 32) (Name "argc") [],- Parameter (PointerType (PointerType (IntegerType 8) (AddrSpace 0)) (AddrSpace 0)) (Name "argv") []+ Parameter i32 (Name "argc") [],+ Parameter (ptr (ptr i8)) (Name "argv") [] ],False), G.basicBlocks = [ BasicBlock (UnName 0) [@@ -104,7 +115,7 @@ isTailCall = False, callingConvention = CC.C, returnAttributes = [],- function = Right (ConstantOperand (C.GlobalReference (Name "foo"))),+ function = Right (ConstantOperand (C.GlobalReference (FunctionType i32 [i32, ptr (ptr i8)] False) (Name "foo"))), arguments = [ (ConstantOperand (C.Int 128 9491828328), []) ],@@ -112,7 +123,7 @@ metadata = [] } ] (- Do $ Ret (Just (LocalReference (UnName 1))) []+ Do $ Ret (Just (LocalReference i32 (UnName 1))) [] ) ] }
test/LLVM/General/Test/Linking.hs view
@@ -36,24 +36,24 @@ ast0 = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults { G.linkage = L.Private,- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "private0" }, GlobalDefinition $ functionDefaults { G.linkage = L.External,- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "external0" } ] ast1 = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults { G.linkage = L.Private,- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "private1" }, GlobalDefinition $ functionDefaults { G.linkage = L.External,- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "external1" } ]
test/LLVM/General/Test/Metadata.hs view
@@ -7,6 +7,8 @@ import LLVM.General.Test.Support import LLVM.General.AST as A+import LLVM.General.AST.Type as A.T+import LLVM.General.AST.AddrSpace as A import qualified LLVM.General.AST.Linkage as L import qualified LLVM.General.AST.Visibility as V import qualified LLVM.General.AST.CallingConvention as CC@@ -16,15 +18,15 @@ tests = testGroup "Metadata" [ testCase "local" $ do let ast = Module "<string>" Nothing Nothing [- GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, G.type' = IntegerType 32 },+ GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, G.type' = i32 }, GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo", G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Load { volatile = False,- address = ConstantOperand (C.GlobalReference (UnName 0)),+ address = ConstantOperand (C.GlobalReference (ptr i32) (UnName 0)), maybeAtomicity = Nothing, A.alignment = 0, metadata = []@@ -34,7 +36,7 @@ ( "my-metadatum", MetadataNode [- Just $ LocalReference (UnName 1),+ Just $ LocalReference i32 (UnName 1), Just $ MetadataStringOperand "super hyper", Nothing ]@@ -57,7 +59,7 @@ testCase "global" $ do let ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo", G.basicBlocks = [ BasicBlock (UnName 0) [@@ -125,7 +127,7 @@ testCase "metadata-global" $ do let ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = Name "foo", G.basicBlocks = [ BasicBlock (UnName 0) [@@ -135,7 +137,7 @@ ] }, MetadataNodeDefinition (MetadataNodeID 0) [- Just $ ConstantOperand (C.GlobalReference (Name "foo"))+ Just $ ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [] False)) (Name "foo")) ] ] let s = "; ModuleID = '<string>'\n\
test/LLVM/General/Test/Module.hs view
@@ -15,9 +15,11 @@ import LLVM.General.Context import LLVM.General.Module+import LLVM.General.Analysis import LLVM.General.Diagnostic import LLVM.General.Target import LLVM.General.AST+import LLVM.General.AST.Type as A.T import LLVM.General.AST.AddrSpace import qualified LLVM.General.AST.IntegerPredicate as IPred @@ -75,27 +77,27 @@ handAST = Module "<string>" Nothing Nothing [ TypeDefinition (UnName 0) ( Just $ StructureType False [- IntegerType 32,- PointerType (NamedTypeReference (UnName 1)) (AddrSpace 0),- PointerType (NamedTypeReference (UnName 0)) (AddrSpace 0)+ i32,+ ptr (NamedTypeReference (UnName 1)),+ ptr (NamedTypeReference (UnName 0)) ]), TypeDefinition (UnName 1) Nothing, GlobalDefinition $ globalVariableDefaults { G.name = UnName 0,- G.type' = IntegerType 32,+ G.type' = i32, G.initializer = Just (C.Int 32 1) }, GlobalDefinition $ globalVariableDefaults { G.name = UnName 1, G.visibility = V.Protected,- G.type' = IntegerType 32,+ G.type' = i32, G.addrSpace = AddrSpace 3, G.section = Just "foo" }, GlobalDefinition $ globalVariableDefaults { G.name = UnName 2, G.hasUnnamedAddr = True,- G.type' = IntegerType 8,+ G.type' = i8, G.initializer = Just (C.Int 8 2) }, GlobalDefinition $ globalVariableDefaults {@@ -104,27 +106,27 @@ }, GlobalDefinition $ globalVariableDefaults { G.name = UnName 4,- G.type' = ArrayType (1 `shift` 32) (IntegerType 32)+ G.type' = ArrayType (1 `shift` 32) i32 }, GlobalDefinition $ globalVariableDefaults { G.name = Name ".argyle",- G.type' = IntegerType 32,+ G.type' = i32, G.initializer = Just (C.Int 32 0), G.isThreadLocal = True }, GlobalDefinition $ globalAliasDefaults { G.name = Name "three", G.linkage = L.Private,- G.type' = PointerType (IntegerType 32) (AddrSpace 3),- G.aliasee = C.GlobalReference (UnName 1)+ G.type' = PointerType i32 (AddrSpace 3),+ G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (UnName 1) }, GlobalDefinition $ globalAliasDefaults { G.name = Name "two",- G.type' = PointerType (IntegerType 32) (AddrSpace 3),- G.aliasee = C.GlobalReference (Name "three")+ G.type' = PointerType i32 (AddrSpace 3),+ G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (Name "three") }, GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "bar", G.basicBlocks = [ BasicBlock (UnName 0) [@@ -132,7 +134,7 @@ isTailCall = False, callingConvention = CC.C, returnAttributes = [A.ZeroExt],- function = Right (ConstantOperand (C.GlobalReference (Name "foo"))),+ function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType i32 [i32, i8] False)) (Name "foo"))), arguments = [ (ConstantOperand (C.Int 32 1), [A.InReg]), (ConstantOperand (C.Int 8 4), [A.SignExt])@@ -141,17 +143,17 @@ metadata = [] } ] (- Do $ Ret (Just (LocalReference (UnName 1))) []+ Do $ Ret (Just (LocalReference i32 (UnName 1))) [] ) ] }, GlobalDefinition $ functionDefaults { G.returnAttributes = [A.ZeroExt],- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo", G.parameters = ([- Parameter (IntegerType 32) (Name "x") [A.InReg],- Parameter (IntegerType 8) (Name "y") [A.SignExt]+ Parameter i32 (Name "x") [A.InReg],+ Parameter i8 (Name "y") [A.SignExt] ], False), G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], G.basicBlocks = [@@ -159,8 +161,8 @@ UnName 1 := Mul { nsw = True, nuw = False,- operand0 = LocalReference (Name "x"),- operand1 = LocalReference (Name "x"),+ operand0 = LocalReference i32 (Name "x"),+ operand1 = LocalReference i32 (Name "x"), metadata = [] } ] (@@ -169,13 +171,13 @@ BasicBlock (Name "here") [ Name "go" := ICmp { iPredicate = IPred.EQ,- operand0 = LocalReference (UnName 1),- operand1 = LocalReference (Name "x"),+ operand0 = LocalReference i32 (UnName 1),+ operand1 = LocalReference i32 (Name "x"), metadata = [] } ] ( Do $ CondBr {- condition = LocalReference (Name "go"),+ condition = LocalReference i1 (Name "go"), trueDest = Name "there", falseDest = Name "elsewhere", metadata' = []@@ -185,7 +187,7 @@ UnName 2 := Add { nsw = True, nuw = False,- operand0 = LocalReference (UnName 1),+ operand0 = LocalReference i32 (UnName 1), operand1 = ConstantOperand (C.Int 32 3), metadata = [] }@@ -194,7 +196,7 @@ ), BasicBlock (Name "elsewhere") [ Name "r" := Phi {- type' = IntegerType 32,+ type' = i32, incomingValues = [ (ConstantOperand (C.Int 32 2), Name "there"), (ConstantOperand (C.Int 32 57), Name "here")@@ -202,7 +204,7 @@ metadata = [] } ] (- Do $ Ret (Just (LocalReference (Name "r"))) []+ Do $ Ret (Just (LocalReference i32 (Name "r"))) [] ) ] }@@ -275,12 +277,64 @@ ast @?= defaultModule { moduleTargetTriple = Just "x86_64-unknown-linux" }, testGroup "regression" [+ testCase "minimal type info" $ withContext $ \context -> do+ let s = "; ModuleID = '<string>'\n\+ \\n\+ \define void @trouble() {\n\+ \entry:\n\+ \ ret void\n\+ \\n\+ \dead0: ; preds = %dead1\n\+ \ %x0 = add i32 %x1, %x1\n\+ \ br label %dead1\n\+ \\n\+ \dead1: ; preds = %dead0\n\+ \ %x1 = add i32 %x0, %x0\n\+ \ br label %dead0\n\+ \}\n"+ ast = Module "<string>" Nothing Nothing [+ GlobalDefinition $ functionDefaults {+ G.returnType = A.T.void,+ G.name = Name "trouble",+ G.basicBlocks = [+ BasicBlock (Name "entry") [+ ] (+ Do $ Ret Nothing []+ ),+ BasicBlock (Name "dead0") [+ Name "x0" := Add {+ nsw = False,+ nuw = False,+ operand0 = LocalReference i32 (Name "x1"),+ operand1 = LocalReference i32 (Name "x1"),+ metadata = []+ }+ ] (+ Do $ Br (Name "dead1") []+ ),+ BasicBlock (Name "dead1") [+ Name "x1" := Add {+ nsw = False,+ nuw = False,+ operand0 = LocalReference i32 (Name "x0"),+ operand1 = LocalReference i32 (Name "x0"),+ metadata = []+ }+ ] (+ Do $ Br (Name "dead0") []+ )+ ]+ }+ ]+ strCheck ast s+ s' <- withContext $ \context -> withModuleFromAST' context ast $ runErrorT . verify+ s' @?= Right (), testCase "set flag on constant expr" $ withContext $ \context -> do let ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Mul {@@ -295,7 +349,7 @@ ), BasicBlock (Name "here") [ ] (- Do $ Ret (Just (LocalReference (UnName 1))) []+ Do $ Ret (Just (LocalReference i32 (UnName 1))) [] ) ] }@@ -306,23 +360,23 @@ testCase "Phi node finishes" $ withContext $ \context -> do let ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Mul { nsw = True, nuw = False,- operand0 = LocalReference (Name "x"),- operand1 = LocalReference (Name "x"),+ operand0 = LocalReference i32 (Name "x"),+ operand1 = LocalReference i32 (Name "x"), metadata = [] } ] ( Do $ Br (Name "here") [] ), BasicBlock (Name "here") [- UnName 2 := Phi (IntegerType 32) [ (ConstantOperand (C.Int 32 42), UnName 0) ] []+ UnName 2 := Phi i32 [ (ConstantOperand (C.Int 32 42), UnName 0) ] [] ] ( Do $ Br (Name "elsewhere") [] ),@@ -332,7 +386,7 @@ ), BasicBlock (Name "there") [ ] (- Do $ Ret (Just (LocalReference (UnName 1))) []+ Do $ Ret (Just (LocalReference i32 (UnName 1))) [] ) ] }@@ -366,17 +420,17 @@ let ast = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults { G.name = Name "foo",- G.returnType = IntegerType 32,- G.parameters = ([Parameter (IntegerType 32) (UnName 0) []], False),+ G.returnType = i32,+ G.parameters = ([Parameter i32 (UnName 0) []], False), G.basicBlocks = [- BasicBlock (UnName 1) [] (Do $ Switch (LocalReference $ UnName 0) (Name "end") cbps [])+ BasicBlock (UnName 1) [] (Do $ Switch (LocalReference i32 (UnName 0)) (Name "end") cbps []) ] ++ [ BasicBlock (UnName n) [] (Do $ Br (Name "end") []) | n <- ns ] ++ [ BasicBlock (Name "end") [- Name "val" := Phi (IntegerType 32) vbps []+ Name "val" := Phi i32 vbps [] ] (- Do $ Ret (Just (LocalReference (Name "val"))) []+ Do $ Ret (Just (LocalReference i32 (Name "val"))) [] ) ] }@@ -392,7 +446,7 @@ \\n\ \@0 = constant %0 { i32 1 }, align 4\n" ast = Module "<string>" Nothing Nothing [- TypeDefinition (UnName 0) (Just $ StructureType False [IntegerType 32]),+ TypeDefinition (UnName 0) (Just $ StructureType False [i32]), GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, G.isConstant = True,@@ -408,9 +462,9 @@ testCase "bad block reference" $ withContext $ \context -> do let badAST = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Mul {@@ -425,7 +479,7 @@ ), BasicBlock (Name "here") [ ] (- Do $ Ret (Just (LocalReference (UnName 1))) []+ Do $ Ret (Just (LocalReference i32 (UnName 1))) [] ) ] }@@ -436,26 +490,26 @@ testCase "multiple" $ withContext $ \context -> do let badAST = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo", G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Mul { nsw = False, nuw = False,- operand0 = LocalReference (Name "unknown"),+ operand0 = LocalReference i32 (Name "unknown"), operand1 = ConstantOperand (C.Int 32 1), metadata = [] }, UnName 2 := Mul { nsw = False, nuw = False,- operand0 = LocalReference (Name "unknown2"),- operand1 = LocalReference (UnName 1),+ operand0 = LocalReference i32 (Name "unknown2"),+ operand1 = LocalReference i32 (UnName 1), metadata = [] } ] (- Do $ Ret (Just (LocalReference (UnName 2))) []+ Do $ Ret (Just (LocalReference i32 (UnName 2))) [] ) ] }
test/LLVM/General/Test/Optimization.hs view
@@ -17,7 +17,7 @@ import LLVM.General.Target import LLVM.General.AST as A-import LLVM.General.AST.Type+import LLVM.General.AST.Type as A.T import LLVM.General.AST.Name import LLVM.General.AST.AddrSpace import LLVM.General.AST.DataLayout@@ -36,9 +36,9 @@ handAST = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], G.basicBlocks = [ BasicBlock (UnName 0) [@@ -55,13 +55,13 @@ BasicBlock (Name "here") [ Name "go" := ICmp { iPredicate = IPred.EQ,- operand0 = LocalReference (UnName 1),+ operand0 = LocalReference i32 (UnName 1), operand1 = ConstantOperand (C.Int 32 42), metadata = [] } ] ( Do $ CondBr {- condition = LocalReference (Name "go"),+ condition = LocalReference i1 (Name "go"), trueDest = Name "take", falseDest = Name "done", metadata' = []@@ -71,8 +71,8 @@ UnName 2 := Sub { nsw = False, nuw = False,- operand0 = LocalReference (Name "x"),- operand1 = LocalReference (Name "x"),+ operand0 = LocalReference i32 (Name "x"),+ operand1 = LocalReference i32 (Name "x"), metadata = [] } ] (@@ -80,15 +80,15 @@ ), BasicBlock (Name "done") [ Name "r" := Phi {- type' = IntegerType 32,+ type' = i32, incomingValues = [- (LocalReference (UnName 2), Name "take"),+ (LocalReference i32 (UnName 2), Name "take"), (ConstantOperand (C.Int 32 57), Name "here") ], metadata = [] } ] (- Do $ Ret (Just (LocalReference (Name "r"))) []+ Do $ Ret (Just (LocalReference i32 (Name "r"))) [] ) ] }@@ -113,9 +113,9 @@ mOut @?= Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], G.basicBlocks = [ BasicBlock (Name "here") [@@ -132,9 +132,9 @@ mOut @?= Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], G.basicBlocks = [ BasicBlock (UnName 0) [] (Do $ Br (Name "here") []),@@ -150,8 +150,8 @@ UnName 1 := Sub { nsw = False, nuw = False,- operand0 = LocalReference (Name "x"),- operand1 = LocalReference (Name "x"),+ operand0 = LocalReference i32 (Name "x"),+ operand1 = LocalReference i32 (Name "x"), metadata = [] } ] (@@ -159,12 +159,12 @@ ), BasicBlock (Name "done") [ Name "r" := Phi {- type' = IntegerType 32,- incomingValues = [(LocalReference (UnName 1),Name "take"),(ConstantOperand (C.Int 32 57), Name "here")],+ type' = i32,+ incomingValues = [(LocalReference i32 (UnName 1), Name "take"),(ConstantOperand (C.Int 32 57), Name "here")], metadata = [] } ] (- Do $ Ret (Just (LocalReference (Name "r"))) []+ Do $ Ret (Just (LocalReference i32 (Name "r"))) [] ) ] }@@ -174,23 +174,23 @@ let mIn = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = FloatingPointType 64 IEEE,+ G.returnType = double, G.name = Name "foo", G.parameters = ([- Parameter (FloatingPointType 64 IEEE) (Name (l ++ n)) []+ Parameter double (Name (l ++ n)) [] | l <- [ "a", "b" ], n <- ["1", "2"] ], False), G.basicBlocks = [ BasicBlock (UnName 0) ([- Name (l ++ n) := op (LocalReference (Name (o1 ++ n))) (LocalReference (Name (o2 ++ n))) []+ Name (l ++ n) := op NoFastMathFlags (LocalReference double (Name (o1 ++ n))) (LocalReference double (Name (o2 ++ n))) [] | (l, op, o1, o2) <- [ ("x", FSub, "a", "b"), ("y", FMul, "x", "a"), ("z", FAdd, "y", "b")], n <- ["1", "2"] ] ++ [- Name "r" := FMul (LocalReference (Name "z1")) (LocalReference (Name "z2")) []- ]) (Do $ Ret (Just (LocalReference (Name "r"))) [])+ Name "r" := FMul NoFastMathFlags (LocalReference double (Name "z1")) (LocalReference double (Name "z2")) []+ ]) (Do $ Ret (Just (LocalReference double (Name "r"))) []) ] } ]@@ -213,32 +213,32 @@ moduleTargetTriple = Just "x86_64", moduleDefinitions = [ GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = Name "foo",- G.parameters = ([Parameter (PointerType (IntegerType 32) (AddrSpace 0)) (Name "x") []], False),+ G.parameters = ([Parameter (ptr i32) (Name "x") []], False), G.basicBlocks = [ BasicBlock (UnName 0) [] (Do $ Br (UnName 1) []), BasicBlock (UnName 1) [- Name "i.0" := Phi (IntegerType 32) [ + Name "i.0" := Phi i32 [ (ConstantOperand (C.Int 32 0), UnName 0),- (LocalReference (UnName 8), UnName 7)+ (LocalReference i32 (UnName 8), UnName 7) ] [],- Name ".0" := Phi (PointerType (IntegerType 32) (AddrSpace 0)) [ - (LocalReference (Name "x"), UnName 0),- (LocalReference (UnName 4), UnName 7)+ Name ".0" := Phi (ptr i32) [ + (LocalReference (ptr i32) (Name "x"), UnName 0),+ (LocalReference (ptr i32) (UnName 4), UnName 7) ] [],- UnName 2 := ICmp IPred.SLT (LocalReference (Name "i.0")) (ConstantOperand (C.Int 32 2048)) []- ] (Do $ CondBr (LocalReference (UnName 2)) (UnName 3) (UnName 9) []),+ UnName 2 := ICmp IPred.SLT (LocalReference i32 (Name "i.0")) (ConstantOperand (C.Int 32 2048)) []+ ] (Do $ CondBr (LocalReference i1 (UnName 2)) (UnName 3) (UnName 9) []), BasicBlock (UnName 3) [- UnName 4 := GetElementPtr True (LocalReference (Name ".0")) [ + UnName 4 := GetElementPtr True (LocalReference (ptr i32) (Name ".0")) [ ConstantOperand (C.Int 32 1) ] [],- UnName 5 := Load False (LocalReference (Name ".0")) Nothing 4 [],- UnName 6 := Add True False (LocalReference (UnName 5)) (ConstantOperand (C.Int 32 1)) [],- Do $ Store False (LocalReference (Name ".0")) (LocalReference (UnName 6)) Nothing 4 [] + UnName 5 := Load False (LocalReference (ptr i32) (Name ".0")) Nothing 4 [],+ UnName 6 := Add True False (LocalReference i32 (UnName 5)) (ConstantOperand (C.Int 32 1)) [],+ Do $ Store False (LocalReference (ptr i32) (Name ".0")) (LocalReference i32 (UnName 6)) Nothing 4 [] ] (Do $ Br (UnName 7) []), BasicBlock (UnName 7) [- UnName 8 := Add True False (LocalReference (Name "i.0")) (ConstantOperand (C.Int 32 1)) []+ UnName 8 := Add True False (LocalReference i32 (Name "i.0")) (ConstantOperand (C.Int 32 1)) [] ] (Do $ Br (UnName 1) []), BasicBlock (UnName 9) [] (Do $ Ret Nothing []) ]@@ -271,9 +271,9 @@ let astIn = Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.basicBlocks = [ BasicBlock (Name "here") [ ] (@@ -287,9 +287,9 @@ moduleAST mIn astOut @?= Module "<string>" Nothing Nothing [ GlobalDefinition $ functionDefaults {- G.returnType = IntegerType 32,+ G.returnType = i32, G.name = Name "foo",- G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False),+ G.parameters = ([Parameter i32 (Name "x") []], False), G.basicBlocks = [ BasicBlock (Name "here") [ ] (@@ -298,7 +298,7 @@ ] }, GlobalDefinition $ functionDefaults {- G.returnType = VoidType,+ G.returnType = A.T.void, G.name = Name "abort" } ]