diff --git a/llvm-general.cabal b/llvm-general.cabal --- a/llvm-general.cabal +++ b/llvm-general.cabal @@ -1,5 +1,5 @@ name: llvm-general -version: 3.2.7.3 +version: 3.2.8.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet @@ -16,7 +16,7 @@ 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 . + For haddock, see . extra-source-files: src/LLVM/General/Internal/FFI/Analysis.h src/LLVM/General/Internal/FFI/Function.h @@ -37,7 +37,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.2 - tag: v3.2.7.3 + tag: v3.2.8.0 flag shared-llvm description: link against llvm shared rather than static library @@ -61,7 +61,7 @@ parsec >= 3.1.3, array >= 0.4.0.0, setenv >= 0.1.0, - llvm-general-pure == 3.2.7.3 + llvm-general-pure == 3.2.8.0 extra-libraries: stdc++ hs-source-dirs: src extensions: @@ -184,8 +184,8 @@ HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1, - llvm-general == 3.2.7.3, - llvm-general-pure == 3.2.7.3, + llvm-general == 3.2.8.0, + llvm-general-pure == 3.2.8.0, containers >= 0.4.2.1, mtl >= 2.0.1.0 hs-source-dirs: test diff --git a/src/LLVM/General/Internal/FFI/Function.hs b/src/LLVM/General/Internal/FFI/Function.hs --- a/src/LLVM/General/Internal/FFI/Function.hs +++ b/src/LLVM/General/Internal/FFI/Function.hs @@ -55,5 +55,8 @@ foreign import ccall unsafe "LLVM_General_AddFunctionRetAttr" addFunctionRetAttr :: Ptr Function -> ParamAttr -> IO () - +foreign import ccall unsafe "LLVMGetGC" getGC :: + Ptr Function -> IO CString +foreign import ccall unsafe "LLVMSetGC" setGC :: + Ptr Function -> CString -> IO () diff --git a/src/LLVM/General/Internal/Function.hs b/src/LLVM/General/Internal/Function.hs --- a/src/LLVM/General/Internal/Function.hs +++ b/src/LLVM/General/Internal/Function.hs @@ -10,6 +10,7 @@ import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import LLVM.General.Internal.DecodeAST +import LLVM.General.Internal.EncodeAST import LLVM.General.Internal.Value import LLVM.General.Internal.Coding import LLVM.General.Internal.Attribute () @@ -38,3 +39,8 @@ `ap` getLocalName param `ap` (liftIO $ getParameterAttrs param) +getGC :: Ptr FFI.Function -> DecodeAST (Maybe String) +getGC f = scopeAnyCont $ decodeM =<< liftIO (FFI.getGC f) + +setGC :: Ptr FFI.Function -> Maybe String -> EncodeAST () +setGC f gc = scopeAnyCont $ liftIO . FFI.setGC f =<< encodeM gc diff --git a/src/LLVM/General/Internal/Module.hs b/src/LLVM/General/Internal/Module.hs --- a/src/LLVM/General/Internal/Module.hs +++ b/src/LLVM/General/Internal/Module.hs @@ -203,7 +203,7 @@ return $ do (liftIO . FFI.setAliasee a') =<< encodeM (A.G.aliasee a) return (FFI.upCast a') - (A.Function _ _ cc rAttrs resultType fName (args,isVarArgs) attrs _ _ blocks) -> do + (A.Function _ _ cc rAttrs resultType fName (args,isVarArgs) attrs _ _ gc blocks) -> do typ <- encodeM $ A.FunctionType resultType (map (\(A.Parameter t _ _) -> t) args) isVarArgs f <- liftIO . withName fName $ \fName -> FFI.addFunction m fName typ defineGlobal fName f @@ -214,6 +214,7 @@ liftIO $ setFunctionAttrs f attrs setSection f (A.G.section g) setAlignment f (A.G.alignment g) + setGC f gc forM blocks $ \(A.BasicBlock bName _ _) -> do b <- liftIO $ withName bName $ \bName -> FFI.appendBasicBlockInContext c f bName defineBasicBlock fName bName b @@ -319,6 +320,7 @@ `ap` (liftIO $ getFunctionAttrs f) `ap` getSection f `ap` getAlignment f + `ap` getGC f `ap` decodeBlocks ] diff --git a/test/LLVM/General/Test/Analysis.hs b/test/LLVM/General/Test/Analysis.hs --- a/test/LLVM/General/Test/Analysis.hs +++ b/test/LLVM/General/Test/Analysis.hs @@ -78,27 +78,32 @@ \}\n" ast = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (FloatingPointType 64 IEEE) (Name "my_function2") ([ - Parameter (PointerType (FloatingPointType 64 IEEE) (AddrSpace 0)) (Name "input_0") [] - ],False) [] Nothing 0 [ - BasicBlock (Name "foo") [ - Name "tmp_input_w0" := GetElementPtr { - inBounds = True, - address = LocalReference (Name "input_0"), - indices = [ConstantOperand (C.Int 64 0)], - metadata = [] - }, - UnName 0 := Load { - volatile = False, - address = LocalReference (Name "tmp_input_w0"), - maybeAtomicity = Nothing, - alignment = 8, - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (UnName 0))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = FloatingPointType 64 IEEE, + G.name = Name "my_function2", + G.parameters = ([ + Parameter (PointerType (FloatingPointType 64 IEEE) (AddrSpace 0)) (Name "input_0") [] + ],False), + G.basicBlocks = [ + BasicBlock (Name "foo") [ + Name "tmp_input_w0" := GetElementPtr { + inBounds = True, + address = LocalReference (Name "input_0"), + indices = [ConstantOperand (C.Int 64 0)], + metadata = [] + }, + UnName 0 := Load { + volatile = False, + address = LocalReference (Name "tmp_input_w0"), + maybeAtomicity = Nothing, + alignment = 8, + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (UnName 0))) [] + ) + ] + } ] strCheck ast str s <- withContext $ \context -> withModuleFromAST' context ast $ runErrorT . verify diff --git a/test/LLVM/General/Test/ExecutionEngine.hs b/test/LLVM/General/Test/ExecutionEngine.hs --- a/test/LLVM/General/Test/ExecutionEngine.hs +++ b/test/LLVM/General/Test/ExecutionEngine.hs @@ -37,15 +37,16 @@ testJIT :: ExecutionEngine e (FunPtr ()) => (Context -> (e -> IO ()) -> IO ()) -> Assertion testJIT withEE = withContext $ \context -> withEE context $ \executionEngine -> do let mAST = Module "runSomethingModule" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "_foo") ([ - Parameter (IntegerType 32) (Name "bar") [] - ],False) [] - Nothing 0 - [ - BasicBlock (UnName 0) [] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 42))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "_foo", + G.parameters = ([Parameter (IntegerType 32) (Name "bar") []],False), + G.basicBlocks = [ + BasicBlock (UnName 0) [] ( + Do $ Ret (Just (ConstantOperand (C.Int 32 42))) [] + ) + ] + } ] s <- withModuleFromAST' context mAST $ \m -> do diff --git a/test/LLVM/General/Test/InlineAssembly.hs b/test/LLVM/General/Test/InlineAssembly.hs --- a/test/LLVM/General/Test/InlineAssembly.hs +++ b/test/LLVM/General/Test/InlineAssembly.hs @@ -21,9 +21,11 @@ testCase "expression" $ do let ast = Module "" Nothing Nothing [ GlobalDefinition $ - Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") - ([Parameter (IntegerType 32) (Name "x") []],False) - [] Nothing 0 [ + functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []],False), + G.basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := Call { isTailCall = False, @@ -47,6 +49,7 @@ Do $ Ret (Just (LocalReference (UnName 1))) [] ) ] + } ] s = "; ModuleID = ''\n\ diff --git a/test/LLVM/General/Test/Instructions.hs b/test/LLVM/General/Test/Instructions.hs --- a/test/LLVM/General/Test/Instructions.hs +++ b/test/LLVM/General/Test/Instructions.hs @@ -33,7 +33,10 @@ testGroup "regular" [ testCase name $ do let mAST = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + 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) [], @@ -41,14 +44,16 @@ Parameter (IntegerType 1) (UnName 4) [], Parameter (VectorType 2 (IntegerType 32)) (UnName 5) [], Parameter (StructureType False [IntegerType 32, IntegerType 32]) (UnName 6) [] - ],False) [] Nothing 0 [ - BasicBlock (UnName 7) [ - namedInstr - ] ( - Do $ Ret Nothing [] - ) - ] - ] + ], False), + G.basicBlocks = [ + BasicBlock (UnName 7) [ + namedInstr + ] ( + Do $ Ret Nothing [] + ) + ] + } + ] mStr = "; ModuleID = ''\n\ \\n\ \define void @0(i32, float, i32*, i64, i1, <2 x i32>, { i32, i32 }) {\n\ @@ -546,27 +551,30 @@ G.isConstant = True, G.initializer = Just $ C.Int 32 42 }, - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (UnName 0) ([ - ],False) [] Nothing 0 [ + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = UnName 0, + G.basicBlocks = [ BasicBlock (UnName 1) [ - UnName 2 := GetElementPtr { - inBounds = True, - address = ConstantOperand (C.GlobalReference (Name "fortytwo")), - indices = [ ConstantOperand (C.Int 32 0) ], - metadata = [] - }, - UnName 3 := Load { - volatile = False, - address = LocalReference (UnName 2), - maybeAtomicity = Nothing, - alignment = 1, - metadata = [] - } - ] ( + UnName 2 := GetElementPtr { + inBounds = True, + address = ConstantOperand (C.GlobalReference (Name "fortytwo")), + indices = [ ConstantOperand (C.Int 32 0) ], + metadata = [] + }, + UnName 3 := Load { + volatile = False, + address = LocalReference (UnName 2), + maybeAtomicity = Nothing, + alignment = 1, + metadata = [] + } + ] ( Do $ Ret (Just (LocalReference (UnName 3))) [] - ) + ) ] - ] + } + ] mStr = "; ModuleID = ''\n\ \\n\ \@0 = constant i32 42\n\ @@ -584,14 +592,16 @@ ( "ret", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - ],False) [] Nothing 0 - [ - BasicBlock (UnName 0) [ - ] ( - Do $ Ret Nothing [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.basicBlocks = [ + BasicBlock (UnName 0) [ + ] ( + Do $ Ret Nothing [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ @@ -601,16 +611,18 @@ ), ( "br", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - ],False) [] Nothing 0 - [ - BasicBlock (UnName 0) [] ( - Do $ Br (Name "foo") [] - ), - BasicBlock (Name "foo") [] ( - Do $ Ret Nothing [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.basicBlocks = [ + BasicBlock (UnName 0) [] ( + Do $ Br (Name "foo") [] + ), + BasicBlock (Name "foo") [] ( + Do $ Ret Nothing [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ @@ -623,16 +635,18 @@ ), ( "condbr", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - ],False) [] Nothing 0 - [ - BasicBlock (Name "bar") [] ( - Do $ CondBr (ConstantOperand (C.Int 1 1)) (Name "foo") (Name "bar") [] - ), - BasicBlock (Name "foo") [] ( - Do $ Ret Nothing [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.basicBlocks = [ + BasicBlock (Name "bar") [] ( + Do $ CondBr (ConstantOperand (C.Int 1 1)) (Name "foo") (Name "bar") [] + ), + BasicBlock (Name "foo") [] ( + Do $ Ret Nothing [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ @@ -646,25 +660,27 @@ ), ( "switch", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - ],False) [] Nothing 0 - [ - BasicBlock (UnName 0) [] ( - Do $ Switch { - operand0' = ConstantOperand (C.Int 16 2), - defaultDest = Name "foo", - dests = [ - (C.Int 16 0, UnName 0), - (C.Int 16 2, Name "foo"), - (C.Int 16 3, UnName 0) - ], - metadata' = [] - } - ), - BasicBlock (Name "foo") [] ( - Do $ Ret Nothing [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.basicBlocks = [ + BasicBlock (UnName 0) [] ( + Do $ Switch { + operand0' = ConstantOperand (C.Int 16 2), + defaultDest = Name "foo", + dests = [ + (C.Int 16 0, UnName 0), + (C.Int 16 2, Name "foo"), + (C.Int 16 3, UnName 0) + ], + metadata' = [] + } + ), + BasicBlock (Name "foo") [] ( + Do $ Ret Nothing [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ @@ -687,28 +703,30 @@ G.type' = PointerType (IntegerType 8) (AddrSpace 0), G.initializer = Just (C.BlockAddress (Name "foo") (UnName 2)) }, - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (Name "foo") ([ - ],False) [] Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Load { - volatile = False, - address = ConstantOperand (C.GlobalReference (UnName 0)), - maybeAtomicity = Nothing, - alignment = 0, - metadata = [] - } - ] ( - Do $ IndirectBr { - operand0' = LocalReference (UnName 1), - possibleDests = [UnName 2], - metadata' = [] - } - ), - BasicBlock (UnName 2) [] ( - Do $ Ret Nothing [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = Name "foo", + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Load { + volatile = False, + address = ConstantOperand (C.GlobalReference (UnName 0)), + maybeAtomicity = Nothing, + alignment = 0, + metadata = [] + } + ] ( + Do $ IndirectBr { + operand0' = LocalReference (UnName 1), + possibleDests = [UnName 2], + metadata' = [] + } + ), + BasicBlock (UnName 2) [] ( + Do $ Ret Nothing [] + ) + ] + } ], -- \ indirectbr i8* null, [label %foo]\n\ "; ModuleID = ''\n\ @@ -725,44 +743,48 @@ ), ( "invoke", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - Parameter (IntegerType 32) (UnName 0) [], - Parameter (IntegerType 16) (UnName 1) [] - ],False) [] Nothing 0 - [ - BasicBlock (UnName 2) [] ( - Do $ Invoke { - callingConvention' = CC.C, - returnAttributes' = [], - function' = Right (ConstantOperand (C.GlobalReference (UnName 0))), - arguments' = [ - (ConstantOperand (C.Int 32 4), []), - (ConstantOperand (C.Int 16 8), []) - ], - functionAttributes' = [], - returnDest = Name "foo", - exceptionDest = Name "bar", - metadata' = [] - } - ), - BasicBlock (Name "foo") [] ( - Do $ Ret Nothing [] - ), - BasicBlock (Name "bar") [ - UnName 3 := LandingPad { - type' = StructureType False [ - PointerType (IntegerType 8) (AddrSpace 0), - IntegerType 32 + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.parameters = ([ + Parameter (IntegerType 32) (UnName 0) [], + Parameter (IntegerType 16) (UnName 1) [] + ], False), + G.basicBlocks = [ + BasicBlock (UnName 2) [] ( + Do $ Invoke { + callingConvention' = CC.C, + returnAttributes' = [], + function' = Right (ConstantOperand (C.GlobalReference (UnName 0))), + arguments' = [ + (ConstantOperand (C.Int 32 4), []), + (ConstantOperand (C.Int 16 8), []) ], - personalityFunction = ConstantOperand (C.GlobalReference (UnName 0)), - cleanup = True, - clauses = [Catch (C.Null (PointerType (IntegerType 8) (AddrSpace 0)))], - metadata = [] - } - ] ( - Do $ Ret Nothing [] - ) - ] + functionAttributes' = [], + returnDest = Name "foo", + exceptionDest = Name "bar", + metadata' = [] + } + ), + BasicBlock (Name "foo") [] ( + Do $ Ret Nothing [] + ), + BasicBlock (Name "bar") [ + UnName 3 := LandingPad { + type' = StructureType False [ + PointerType (IntegerType 8) (AddrSpace 0), + IntegerType 32 + ], + personalityFunction = ConstantOperand (C.GlobalReference (UnName 0)), + cleanup = True, + clauses = [Catch (C.Null (PointerType (IntegerType 8) (AddrSpace 0)))], + metadata = [] + } + ] ( + Do $ Ret Nothing [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ @@ -782,13 +804,15 @@ ), ( "resume", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - ],False) [] Nothing 0 - [ - BasicBlock (UnName 0) [] ( - Do $ Resume (ConstantOperand (C.Int 32 1)) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.basicBlocks = [ + BasicBlock (UnName 0) [] ( + Do $ Resume (ConstantOperand (C.Int 32 1)) [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ @@ -798,13 +822,15 @@ ), ( "unreachable", Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (VoidType) (UnName 0) ([ - ],False) [] Nothing 0 - [ - BasicBlock (UnName 0) [] ( - Do $ Unreachable [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = UnName 0, + G.basicBlocks = [ + BasicBlock (UnName 0) [] ( + Do $ Unreachable [] + ) + ] + } ], "; ModuleID = ''\n\ \\n\ diff --git a/test/LLVM/General/Test/Instrumentation.hs b/test/LLVM/General/Test/Instrumentation.hs --- a/test/LLVM/General/Test/Instrumentation.hs +++ b/test/LLVM/General/Test/Instrumentation.hs @@ -39,81 +39,83 @@ ast = do dl <- withDefaultTargetMachine getTargetMachineDataLayout return $ Module "" (Just dl) Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 128) (Name "x") [] - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [] (Do $ Br (Name "checkDone") []), - BasicBlock (Name "checkDone") [ - UnName 1 := Phi { - type' = IntegerType 128, - incomingValues = [ - (LocalReference (Name "x"), UnName 0), - (LocalReference (Name "x'"), Name "even"), - (LocalReference (Name "x''"), Name "odd") - ], - metadata = [] - }, - Name "count" := Phi { - type' = IntegerType 32, - incomingValues = [ - (ConstantOperand (C.Int 32 1), UnName 0), - (LocalReference (Name "count'"), Name "even"), - (LocalReference (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)) [] - ] ( - Do $ CondBr (LocalReference (Name "is one")) (Name "done") (Name "checkOdd") [] - ), - BasicBlock (Name "checkOdd") [ - Name "is odd" := Trunc (LocalReference (UnName 1)) (IntegerType 1) [] - ] ( - Do $ CondBr (LocalReference (Name "is odd")) (Name "odd") (Name "even") [] - ), - BasicBlock (Name "even") [ - Name "x'" := UDiv True (LocalReference (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)) [] - ] ( - Do $ Br (Name "checkDone") [] - ), - BasicBlock (Name "done") [ - ] ( - Do $ Ret (Just (LocalReference (Name "count'"))) [] - ) - ], - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "main") ([ + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 128) (Name "x") []],False), + G.basicBlocks = [ + BasicBlock (UnName 0) [] (Do $ Br (Name "checkDone") []), + BasicBlock (Name "checkDone") [ + UnName 1 := Phi { + type' = IntegerType 128, + incomingValues = [ + (LocalReference (Name "x"), UnName 0), + (LocalReference (Name "x'"), Name "even"), + (LocalReference (Name "x''"), Name "odd") + ], + metadata = [] + }, + Name "count" := Phi { + type' = IntegerType 32, + incomingValues = [ + (ConstantOperand (C.Int 32 1), UnName 0), + (LocalReference (Name "count'"), Name "even"), + (LocalReference (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)) [] + ] ( + Do $ CondBr (LocalReference (Name "is one")) (Name "done") (Name "checkOdd") [] + ), + BasicBlock (Name "checkOdd") [ + Name "is odd" := Trunc (LocalReference (UnName 1)) (IntegerType 1) [] + ] ( + Do $ CondBr (LocalReference (Name "is odd")) (Name "odd") (Name "even") [] + ), + BasicBlock (Name "even") [ + Name "x'" := UDiv True (LocalReference (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)) [] + ] ( + Do $ Br (Name "checkDone") [] + ), + BasicBlock (Name "done") [ + ] ( + Do $ Ret (Just (LocalReference (Name "count'"))) [] + ) + ] + }, + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "main", + G.parameters = ([ Parameter (IntegerType 32) (Name "argc") [], Parameter (PointerType (PointerType (IntegerType 8) (AddrSpace 0)) (AddrSpace 0)) (Name "argv") [] - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Call { - isTailCall = False, - callingConvention = CC.C, - returnAttributes = [], - function = Right (ConstantOperand (C.GlobalReference (Name "foo"))), - arguments = [ - (ConstantOperand (C.Int 128 9491828328), []) - ], - functionAttributes = [], - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (UnName 1))) [] - ) - ] + ],False), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Call { + isTailCall = False, + callingConvention = CC.C, + returnAttributes = [], + function = Right (ConstantOperand (C.GlobalReference (Name "foo"))), + arguments = [ + (ConstantOperand (C.Int 128 9491828328), []) + ], + functionAttributes = [], + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (UnName 1))) [] + ) + ] + } ] tests = testGroup "Instrumentation" [ diff --git a/test/LLVM/General/Test/Metadata.hs b/test/LLVM/General/Test/Metadata.hs --- a/test/LLVM/General/Test/Metadata.hs +++ b/test/LLVM/General/Test/Metadata.hs @@ -16,33 +16,33 @@ tests = testGroup "Metadata" [ testCase "local" $ do let ast = Module "" Nothing Nothing [ - GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, G.type' = IntegerType 32 }, - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Load { - volatile = False, - address = ConstantOperand (C.GlobalReference (UnName 0)), - maybeAtomicity = Nothing, - A.alignment = 0, - metadata = [] - } - ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [ - ( - "my-metadatum", - MetadataNode [ - Just $ LocalReference (UnName 1), - Just $ MetadataStringOperand "super hyper", - Nothing - ] - ) - ] - ) - ] + GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, G.type' = IntegerType 32 }, + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Load { + volatile = False, + address = ConstantOperand (C.GlobalReference (UnName 0)), + maybeAtomicity = Nothing, + A.alignment = 0, + metadata = [] + } + ] ( + Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [ + ( + "my-metadatum", + MetadataNode [ + Just $ LocalReference (UnName 1), + Just $ MetadataStringOperand "super hyper", + Nothing + ] + ) + ] + ) + ] + } ] let s = "; ModuleID = ''\n\ \\n\ @@ -56,18 +56,18 @@ testCase "global" $ do let ast = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [ + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.basicBlocks = [ + BasicBlock (UnName 0) [ ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [ - ("my-metadatum", MetadataNodeReference (MetadataNodeID 0)) - ] - ) - ], + Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [ + ("my-metadatum", MetadataNodeReference (MetadataNodeID 0)) + ] + ) + ] + }, MetadataNodeDefinition (MetadataNodeID 0) [ Just $ ConstantOperand (C.Int 32 1) ] ] let s = "; ModuleID = ''\n\ @@ -124,16 +124,16 @@ testCase "metadata-global" $ do let ast = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] VoidType (Name "foo") ([ - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [ - ] ( - Do $ Ret Nothing [ ("my-metadatum", MetadataNodeReference (MetadataNodeID 0)) ] - ) - ], + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = Name "foo", + G.basicBlocks = [ + BasicBlock (UnName 0) [ + ] ( + Do $ Ret Nothing [ ("my-metadatum", MetadataNodeReference (MetadataNodeID 0)) ] + ) + ] + }, MetadataNodeDefinition (MetadataNodeID 0) [ Just $ ConstantOperand (C.GlobalReference (Name "foo")) ] diff --git a/test/LLVM/General/Test/Module.hs b/test/LLVM/General/Test/Module.hs --- a/test/LLVM/General/Test/Module.hs +++ b/test/LLVM/General/Test/Module.hs @@ -120,80 +120,89 @@ G.type' = PointerType (IntegerType 32) (AddrSpace 3), G.aliasee = C.GlobalReference (Name "three") }, - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "bar") ([],False) [] Nothing 0 [ - BasicBlock (UnName 0) [ - UnName 1 := Call { - isTailCall = False, - callingConvention = CC.C, - returnAttributes = [A.ZeroExt], - function = Right (ConstantOperand (C.GlobalReference (Name "foo"))), - arguments = [ - (ConstantOperand (C.Int 32 1), [A.InReg]), - (ConstantOperand (C.Int 8 4), [A.SignExt]) - ], - functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (UnName 1))) [] - ) - ], - GlobalDefinition $ Function L.External V.Default CC.C [A.ZeroExt] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [A.InReg], - Parameter (IntegerType 8) (Name "y") [A.SignExt] - ],False) - [A.NoUnwind, A.ReadNone, A.UWTable] Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Mul { - nsw = True, - nuw = False, - operand0 = LocalReference (Name "x"), - operand1 = LocalReference (Name "x"), - metadata = [] - } - ] ( - Do $ Br (Name "here") [] - ), - BasicBlock (Name "here") [ - Name "go" := ICmp { - iPredicate = IPred.EQ, - operand0 = LocalReference (UnName 1), - operand1 = LocalReference (Name "x"), - metadata = [] - } - ] ( - Do $ CondBr { - condition = LocalReference (Name "go"), - trueDest = Name "there", - falseDest = Name "elsewhere", - metadata' = [] - } - ), - BasicBlock (Name "there") [ - UnName 2 := Add { - nsw = True, - nuw = False, - operand0 = LocalReference (UnName 1), - operand1 = ConstantOperand (C.Int 32 3), - metadata = [] - } - ] ( - Do $ Br (Name "elsewhere") [] - ), - BasicBlock (Name "elsewhere") [ - Name "r" := Phi { - type' = IntegerType 32, - incomingValues = [ - (ConstantOperand (C.Int 32 2), Name "there"), - (ConstantOperand (C.Int 32 57), Name "here") - ], - metadata = [] - } + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "bar", + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Call { + isTailCall = False, + callingConvention = CC.C, + returnAttributes = [A.ZeroExt], + function = Right (ConstantOperand (C.GlobalReference (Name "foo"))), + arguments = [ + (ConstantOperand (C.Int 32 1), [A.InReg]), + (ConstantOperand (C.Int 8 4), [A.SignExt]) + ], + functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], + metadata = [] + } ] ( - Do $ Ret (Just (LocalReference (Name "r"))) [] + Do $ Ret (Just (LocalReference (UnName 1))) [] ) - ] + ] + }, + GlobalDefinition $ functionDefaults { + G.returnAttributes = [A.ZeroExt], + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([ + Parameter (IntegerType 32) (Name "x") [A.InReg], + Parameter (IntegerType 8) (Name "y") [A.SignExt] + ], False), + G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Mul { + nsw = True, + nuw = False, + operand0 = LocalReference (Name "x"), + operand1 = LocalReference (Name "x"), + metadata = [] + } + ] ( + Do $ Br (Name "here") [] + ), + BasicBlock (Name "here") [ + Name "go" := ICmp { + iPredicate = IPred.EQ, + operand0 = LocalReference (UnName 1), + operand1 = LocalReference (Name "x"), + metadata = [] + } + ] ( + Do $ CondBr { + condition = LocalReference (Name "go"), + trueDest = Name "there", + falseDest = Name "elsewhere", + metadata' = [] + } + ), + BasicBlock (Name "there") [ + UnName 2 := Add { + nsw = True, + nuw = False, + operand0 = LocalReference (UnName 1), + operand1 = ConstantOperand (C.Int 32 3), + metadata = [] + } + ] ( + Do $ Br (Name "elsewhere") [] + ), + BasicBlock (Name "elsewhere") [ + Name "r" := Phi { + type' = IntegerType 32, + incomingValues = [ + (ConstantOperand (C.Int 32 2), Name "there"), + (ConstantOperand (C.Int 32 57), Name "here") + ], + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (Name "r"))) [] + ) + ] + } ] tests = testGroup "Module" [ @@ -233,63 +242,65 @@ testGroup "regression" [ testCase "set flag on constant expr" $ withContext $ \context -> do let ast = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) - [] Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Mul { - nsw = True, - nuw = False, - operand0 = ConstantOperand (C.Int 32 1), - operand1 = ConstantOperand (C.Int 32 1), - metadata = [] - } - ] ( - Do $ Br (Name "here") [] - ), - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (LocalReference (UnName 1))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Mul { + nsw = True, + nuw = False, + operand0 = ConstantOperand (C.Int 32 1), + operand1 = ConstantOperand (C.Int 32 1), + metadata = [] + } + ] ( + Do $ Br (Name "here") [] + ), + BasicBlock (Name "here") [ + ] ( + Do $ Ret (Just (LocalReference (UnName 1))) [] + ) + ] + } ] t <- withModuleFromAST' context ast $ \_ -> return True t @?= True, testCase "Phi node finishes" $ withContext $ \context -> do let ast = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) - [] Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Mul { - nsw = True, - nuw = False, - operand0 = LocalReference (Name "x"), - operand1 = LocalReference (Name "x"), - metadata = [] - } - ] ( - Do $ Br (Name "here") [] - ), - BasicBlock (Name "here") [ - UnName 2 := Phi (IntegerType 32) [ (ConstantOperand (C.Int 32 42), UnName 0) ] [] - ] ( - Do $ Br (Name "elsewhere") [] - ), - BasicBlock (Name "elsewhere") [ - ] ( - Do $ Br (Name "there") [] - ), - BasicBlock (Name "there") [ - ] ( - Do $ Ret (Just (LocalReference (UnName 1))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Mul { + nsw = True, + nuw = False, + operand0 = LocalReference (Name "x"), + operand1 = LocalReference (Name "x"), + metadata = [] + } + ] ( + Do $ Br (Name "here") [] + ), + BasicBlock (Name "here") [ + UnName 2 := Phi (IntegerType 32) [ (ConstantOperand (C.Int 32 42), UnName 0) ] [] + ] ( + Do $ Br (Name "elsewhere") [] + ), + BasicBlock (Name "elsewhere") [ + ] ( + Do $ Br (Name "there") [] + ), + BasicBlock (Name "there") [ + ] ( + Do $ Ret (Just (LocalReference (UnName 1))) [] + ) + ] + } ] s = "; ModuleID = ''\n\ \\n\ @@ -343,56 +354,58 @@ testGroup "failures" [ testCase "bad block reference" $ withContext $ \context -> do let badAST = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) - [] Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Mul { - nsw = True, - nuw = False, - operand0 = ConstantOperand (C.Int 32 1), - operand1 = ConstantOperand (C.Int 32 1), - metadata = [] - } - ] ( - Do $ Br (Name "not here") [] - ), - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (LocalReference (UnName 1))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Mul { + nsw = True, + nuw = False, + operand0 = ConstantOperand (C.Int 32 1), + operand1 = ConstantOperand (C.Int 32 1), + metadata = [] + } + ] ( + Do $ Br (Name "not here") [] + ), + BasicBlock (Name "here") [ + ] ( + Do $ Ret (Just (LocalReference (UnName 1))) [] + ) + ] + } ] t <- runErrorT $ withModuleFromAST context badAST $ \_ -> return True t @?= Left "reference to undefined block: Name \"not here\"", testCase "multiple" $ withContext $ \context -> do let badAST = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - ],False) - [] Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Mul { - nsw = False, - nuw = False, - operand0 = LocalReference (Name "unknown"), - operand1 = ConstantOperand (C.Int 32 1), - metadata = [] - }, - UnName 2 := Mul { - nsw = False, - nuw = False, - operand0 = LocalReference (Name "unknown2"), - operand1 = LocalReference (UnName 1), - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (UnName 2))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Mul { + nsw = False, + nuw = False, + operand0 = LocalReference (Name "unknown"), + operand1 = ConstantOperand (C.Int 32 1), + metadata = [] + }, + UnName 2 := Mul { + nsw = False, + nuw = False, + operand0 = LocalReference (Name "unknown2"), + operand1 = LocalReference (UnName 1), + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (UnName 2))) [] + ) + ] + } ] t <- runErrorT $ withModuleFromAST context badAST $ \_ -> return True t @?= Left "reference to undefined local: Name \"unknown\"" diff --git a/test/LLVM/General/Test/Optimization.hs b/test/LLVM/General/Test/Optimization.hs --- a/test/LLVM/General/Test/Optimization.hs +++ b/test/LLVM/General/Test/Optimization.hs @@ -35,63 +35,64 @@ handAST = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) - [A.NoUnwind, A.ReadNone, A.UWTable] - Nothing 0 - [ - BasicBlock (UnName 0) [ - UnName 1 := Mul { - nsw = False, - nuw = False, - operand0 = ConstantOperand (C.Int 32 6), - operand1 = ConstantOperand (C.Int 32 7), - metadata = [] - } - ] ( - Do $ Br (Name "here") [] - ), - BasicBlock (Name "here") [ - Name "go" := ICmp { - iPredicate = IPred.EQ, - operand0 = LocalReference (UnName 1), - operand1 = ConstantOperand (C.Int 32 42), - metadata = [] - } - ] ( - Do $ CondBr { - condition = LocalReference (Name "go"), - trueDest = Name "take", - falseDest = Name "done", - metadata' = [] - } - ), - BasicBlock (Name "take") [ - UnName 2 := Sub { - nsw = False, - nuw = False, - operand0 = LocalReference (Name "x"), - operand1 = LocalReference (Name "x"), - metadata = [] - } - ] ( - Do $ Br (Name "done") [] - ), - BasicBlock (Name "done") [ - Name "r" := Phi { - type' = IntegerType 32, - incomingValues = [ - (LocalReference (UnName 2), Name "take"), - (ConstantOperand (C.Int 32 57), Name "here") - ], - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (Name "r"))) [] - ) - ] - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Mul { + nsw = False, + nuw = False, + operand0 = ConstantOperand (C.Int 32 6), + operand1 = ConstantOperand (C.Int 32 7), + metadata = [] + } + ] ( + Do $ Br (Name "here") [] + ), + BasicBlock (Name "here") [ + Name "go" := ICmp { + iPredicate = IPred.EQ, + operand0 = LocalReference (UnName 1), + operand1 = ConstantOperand (C.Int 32 42), + metadata = [] + } + ] ( + Do $ CondBr { + condition = LocalReference (Name "go"), + trueDest = Name "take", + falseDest = Name "done", + metadata' = [] + } + ), + BasicBlock (Name "take") [ + UnName 2 := Sub { + nsw = False, + nuw = False, + operand0 = LocalReference (Name "x"), + operand1 = LocalReference (Name "x"), + metadata = [] + } + ] ( + Do $ Br (Name "done") [] + ), + BasicBlock (Name "done") [ + Name "r" := Phi { + type' = IntegerType 32, + incomingValues = [ + (LocalReference (UnName 2), Name "take"), + (ConstantOperand (C.Int 32 57), Name "here") + ], + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (Name "r"))) [] + ) + ] + } + ] optimize :: PassSetSpec -> A.Module -> IO A.Module optimize pss m = withContext $ \context -> withModuleFromAST' context m $ \mIn' -> do @@ -103,17 +104,18 @@ mOut <- optimize defaultCuratedPassSetSpec handAST mOut @?= Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) - [A.NoUnwind, A.ReadNone, A.UWTable] - Nothing 0 - [ - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], + G.basicBlocks = [ + BasicBlock (Name "here") [ + ] ( + Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] + ) + ] + } ], testGroup "individual" [ @@ -121,168 +123,172 @@ mOut <- optimize defaultPassSetSpec { transforms = [ConstantPropagation] } handAST mOut @?= Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) - [A.NoUnwind, A.ReadNone, A.UWTable] - Nothing 0 - [ - BasicBlock (UnName 0) [] (Do $ Br (Name "here") []), - BasicBlock (Name "here") [] ( - Do $ CondBr { - condition = ConstantOperand (C.Int 1 1), - trueDest = Name "take", - falseDest = Name "done", - metadata' = [] - } - ), - BasicBlock (Name "take") [ - UnName 1 := Sub { - nsw = False, - nuw = False, - operand0 = LocalReference (Name "x"), - operand1 = LocalReference (Name "x"), - metadata = [] - } - ] ( - Do $ Br (Name "done") [] - ), - BasicBlock (Name "done") [ - Name "r" := Phi { - type' = IntegerType 32, - incomingValues = [(LocalReference (UnName 1),Name "take"),(ConstantOperand (C.Int 32 57), Name "here")], - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (Name "r"))) [] - ) - ] - ], + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], + G.basicBlocks = [ + BasicBlock (UnName 0) [] (Do $ Br (Name "here") []), + BasicBlock (Name "here") [] ( + Do $ CondBr { + condition = ConstantOperand (C.Int 1 1), + trueDest = Name "take", + falseDest = Name "done", + metadata' = [] + } + ), + BasicBlock (Name "take") [ + UnName 1 := Sub { + nsw = False, + nuw = False, + operand0 = LocalReference (Name "x"), + operand1 = LocalReference (Name "x"), + metadata = [] + } + ] ( + Do $ Br (Name "done") [] + ), + BasicBlock (Name "done") [ + Name "r" := Phi { + type' = IntegerType 32, + incomingValues = [(LocalReference (UnName 1),Name "take"),(ConstantOperand (C.Int 32 57), Name "here")], + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (Name "r"))) [] + ) + ] + } + ], testCase "BasicBlockVectorization" $ do let mIn = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (FloatingPointType 64 IEEE) (Name "foo") ([ - Parameter (FloatingPointType 64 IEEE) (Name "a1") [], - Parameter (FloatingPointType 64 IEEE) (Name "a2") [], - Parameter (FloatingPointType 64 IEEE) (Name "b1") [], - Parameter (FloatingPointType 64 IEEE) (Name "b2") [] - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [ - Name "x1" := FSub { - operand0 = LocalReference (Name "a1"), - operand1 = LocalReference (Name "b1"), - metadata = [] - }, - Name "x2" := FSub { - operand0 = LocalReference (Name "a2"), - operand1 = LocalReference (Name "b2"), - metadata = [] - }, - Name "y1" := FMul { - operand0 = LocalReference (Name "x1"), - operand1 = LocalReference (Name "a1"), - metadata = [] - }, - Name "y2" := FMul { - operand0 = LocalReference (Name "x2"), - operand1 = LocalReference (Name "a2"), - metadata = [] - }, - Name "z1" := FAdd { - operand0 = LocalReference (Name "y1"), - operand1 = LocalReference (Name "b1"), - metadata = [] - }, - Name "z2" := FAdd { - operand0 = LocalReference (Name "y2"), - operand1 = LocalReference (Name "b2"), - metadata = [] - }, - Name "r" := FMul { - operand0 = LocalReference (Name "z1"), - operand1 = LocalReference (Name "z2"), - metadata = [] - } - ] (Do $ Ret (Just (LocalReference (Name "r"))) []) - ] - ] - mOut <- - optimize (defaultPassSetSpec { transforms = [ defaultVectorizeBasicBlocks { vectorizePointers = False, requiredChainDepth = 3 }, InstructionCombining, GlobalValueNumbering False ] }) mIn - mOut @?= Module "" Nothing Nothing [ - GlobalDefinition $ Function - L.External V.Default CC.C [] (FloatingPointType 64 IEEE) (Name "foo") ([ + GlobalDefinition $ functionDefaults { + G.returnType = FloatingPointType 64 IEEE, + G.name = Name "foo", + G.parameters = ([ Parameter (FloatingPointType 64 IEEE) (Name "a1") [], Parameter (FloatingPointType 64 IEEE) (Name "a2") [], Parameter (FloatingPointType 64 IEEE) (Name "b1") [], Parameter (FloatingPointType 64 IEEE) (Name "b2") [] - ],False) - [] - Nothing 0 - [ - BasicBlock (UnName 0) [ - Name "x1.v.i1.1" := InsertElement { - vector = ConstantOperand (C.Undef (VectorType 2 (FloatingPointType 64 IEEE))), - element = LocalReference (Name "b1"), - index = ConstantOperand (C.Int 32 0), - metadata = [] - }, - Name "x1.v.i1.2" := InsertElement { - vector = LocalReference (Name "x1.v.i1.1"), - element = LocalReference (Name "b2"), - index = ConstantOperand (C.Int 32 1), - metadata = [] - }, - Name "x1.v.i0.1" := InsertElement { - vector = ConstantOperand (C.Undef (VectorType 2 (FloatingPointType 64 IEEE))), - element = LocalReference (Name "a1"), - index = ConstantOperand (C.Int 32 0), - metadata = [] - }, - Name "x1.v.i0.2" := InsertElement { - vector = LocalReference (Name "x1.v.i0.1"), - element = LocalReference (Name "a2"), - index = ConstantOperand (C.Int 32 1), - metadata = [] - }, - Name "x1" := FSub { - operand0 = LocalReference (Name "x1.v.i0.2"), - operand1 = LocalReference (Name "x1.v.i1.2"), - metadata = [] - }, - Name "y1" := FMul { - operand0 = LocalReference (Name "x1"), - operand1 = LocalReference (Name "x1.v.i0.2"), - metadata = [] - }, - Name "z1" := FAdd { - operand0 = LocalReference (Name "y1"), - operand1 = LocalReference (Name "x1.v.i1.2"), - metadata = [] - }, - Name "z1.v.r1" := ExtractElement { - vector = LocalReference (Name "z1"), - index = ConstantOperand (C.Int 32 0), - metadata = [] - }, - Name "z1.v.r2" := ExtractElement { - vector = LocalReference (Name "z1"), - index = ConstantOperand (C.Int 32 1), - metadata = [] - }, - Name "r" := FMul { - operand0 = LocalReference (Name "z1.v.r1"), - operand1 = LocalReference (Name "z1.v.r2"), - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference (Name "r"))) [] - ) - ] - ], + ], False), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + Name "x1" := FSub { + operand0 = LocalReference (Name "a1"), + operand1 = LocalReference (Name "b1"), + metadata = [] + }, + Name "x2" := FSub { + operand0 = LocalReference (Name "a2"), + operand1 = LocalReference (Name "b2"), + metadata = [] + }, + Name "y1" := FMul { + operand0 = LocalReference (Name "x1"), + operand1 = LocalReference (Name "a1"), + metadata = [] + }, + Name "y2" := FMul { + operand0 = LocalReference (Name "x2"), + operand1 = LocalReference (Name "a2"), + metadata = [] + }, + Name "z1" := FAdd { + operand0 = LocalReference (Name "y1"), + operand1 = LocalReference (Name "b1"), + metadata = [] + }, + Name "z2" := FAdd { + operand0 = LocalReference (Name "y2"), + operand1 = LocalReference (Name "b2"), + metadata = [] + }, + Name "r" := FMul { + operand0 = LocalReference (Name "z1"), + operand1 = LocalReference (Name "z2"), + metadata = [] + } + ] (Do $ Ret (Just (LocalReference (Name "r"))) []) + ] + } + ] + mOut <- + optimize (defaultPassSetSpec { transforms = [ defaultVectorizeBasicBlocks { requiredChainDepth = 3 }, InstructionCombining, GlobalValueNumbering False ] }) mIn + mOut @?= Module "" Nothing Nothing [ + GlobalDefinition $ functionDefaults { + G.returnType = FloatingPointType 64 IEEE, + G.name = Name "foo", + G.parameters = ([ + Parameter (FloatingPointType 64 IEEE) (Name "a1") [], + Parameter (FloatingPointType 64 IEEE) (Name "a2") [], + Parameter (FloatingPointType 64 IEEE) (Name "b1") [], + Parameter (FloatingPointType 64 IEEE) (Name "b2") [] + ], False), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + Name "x1.v.i1.1" := InsertElement { + vector = ConstantOperand (C.Undef (VectorType 2 (FloatingPointType 64 IEEE))), + element = LocalReference (Name "b1"), + index = ConstantOperand (C.Int 32 0), + metadata = [] + }, + Name "x1.v.i1.2" := InsertElement { + vector = LocalReference (Name "x1.v.i1.1"), + element = LocalReference (Name "b2"), + index = ConstantOperand (C.Int 32 1), + metadata = [] + }, + Name "x1.v.i0.1" := InsertElement { + vector = ConstantOperand (C.Undef (VectorType 2 (FloatingPointType 64 IEEE))), + element = LocalReference (Name "a1"), + index = ConstantOperand (C.Int 32 0), + metadata = [] + }, + Name "x1.v.i0.2" := InsertElement { + vector = LocalReference (Name "x1.v.i0.1"), + element = LocalReference (Name "a2"), + index = ConstantOperand (C.Int 32 1), + metadata = [] + }, + Name "x1" := FSub { + operand0 = LocalReference (Name "x1.v.i0.2"), + operand1 = LocalReference (Name "x1.v.i1.2"), + metadata = [] + }, + Name "y1" := FMul { + operand0 = LocalReference (Name "x1"), + operand1 = LocalReference (Name "x1.v.i0.2"), + metadata = [] + }, + Name "z1" := FAdd { + operand0 = LocalReference (Name "y1"), + operand1 = LocalReference (Name "x1.v.i1.2"), + metadata = [] + }, + Name "z1.v.r1" := ExtractElement { + vector = LocalReference (Name "z1"), + index = ConstantOperand (C.Int 32 0), + metadata = [] + }, + Name "z1.v.r2" := ExtractElement { + vector = LocalReference (Name "z1"), + index = ConstantOperand (C.Int 32 1), + metadata = [] + }, + Name "r" := FMul { + operand0 = LocalReference (Name "z1.v.r1"), + operand1 = LocalReference (Name "z1.v.r2"), + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference (Name "r"))) [] + ) + ] + } + ], testCase "LowerInvoke" $ do -- This test doesn't test much about what LowerInvoke does, just that it seems to work. @@ -298,29 +304,37 @@ withPassManager (defaultPassSetSpec { transforms = [LowerInvoke False], targetLowering = Just tl}) $ \passManager -> do let astIn = Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) [] Nothing 0 [ - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] - ) - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.basicBlocks = [ + BasicBlock (Name "here") [ + ] ( + Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] + ) + ] + } ] astOut <- withModuleFromAST' context astIn $ \mIn -> do runPassManager passManager mIn moduleAST mIn astOut @?= Module "" Nothing Nothing [ - GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([ - Parameter (IntegerType 32) (Name "x") [] - ],False) [] Nothing 0 [ - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] - ) - ], - GlobalDefinition $ Function L.External V.Default CC.C [] VoidType (Name "abort") ([],False) - [] Nothing 0 [] - ] + GlobalDefinition $ functionDefaults { + G.returnType = IntegerType 32, + G.name = Name "foo", + G.parameters = ([Parameter (IntegerType 32) (Name "x") []], False), + G.basicBlocks = [ + BasicBlock (Name "here") [ + ] ( + Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] + ) + ] + }, + GlobalDefinition $ functionDefaults { + G.returnType = VoidType, + G.name = Name "abort" + } + ] ] ]