llvm-general 3.3.0.1 → 3.3.0.2
raw patch · 5 files changed
+112/−35 lines, 5 files
Files
- llvm-general.cabal +9/−2
- src/LLVM/General/Internal/Instruction.hs +41/−27
- src/LLVM/General/Internal/Module.hs +10/−4
- test/LLVM/General/Test/Module.hs +52/−1
- test/LLVM/General/Test/Tests.hs +0/−1
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.3.0.1+version: 3.3.0.2 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -34,12 +34,16 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.3- tag: v3.3.0.1+ tag: v3.3.0.2 flag shared-llvm description: link against llvm shared rather than static library default: False +flag debug+ description: compile C(++) shims with debug info for ease of troubleshooting+ default: False+ library build-tools: llvm-config ghc-options: -fwarn-unused-imports@@ -172,6 +176,9 @@ src/LLVM/General/Internal/FFI/TargetC.cpp src/LLVM/General/Internal/FFI/TypeC.cpp src/LLVM/General/Internal/FFI/ValueC.cpp++ if flag(debug)+ cc-options: -g test-suite test type: exitcode-stdio-1.0
src/LLVM/General/Internal/Instruction.hs view
@@ -4,7 +4,8 @@ TupleSections, MultiParamTypeClasses, FlexibleContexts,- FlexibleInstances+ FlexibleInstances,+ UndecidableInstances #-} module LLVM.General.Internal.Instruction where @@ -333,9 +334,10 @@ ] ) - instance EncodeM EncodeAST A.Instruction (Ptr FFI.Instruction) where+ instance EncodeM EncodeAST A.Instruction (Ptr FFI.Instruction, EncodeAST ()) where encodeM o = scopeAnyCont $ do builder <- gets encodeStateBuilder+ let return' i = return (FFI.upCast i, return ()) s <- encodeM "" $( [|@@ -350,7 +352,7 @@ op1' <- encodeM op1 pred <- encodeM pred i <- liftIO $ FFI.buildICmp builder pred op0' op1' s- return $ FFI.upCast i+ return' i A.FCmp { A.fpPredicate = pred, A.operand0 = op0, @@ -361,16 +363,18 @@ op1' <- encodeM op1 pred <- encodeM pred i <- liftIO $ FFI.buildFCmp builder pred op0' op1' s- return $ FFI.upCast i+ return' i A.Phi { A.type' = t, A.incomingValues = ivs } -> do t' <- encodeM t i <- liftIO $ FFI.buildPhi builder t' s- defer- let (ivs3, bs3) = unzip ivs- ivs3' <- encodeM ivs3- bs3' <- encodeM bs3- liftIO $ FFI.addIncoming i ivs3' bs3'- return $ FFI.upCast i+ 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,@@ -394,46 +398,46 @@ liftIO $ FFI.setTailCall i tc cc <- encodeM cc liftIO $ FFI.setInstructionCallConv i cc- return $ FFI.upCast i+ 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 $ FFI.upCast i+ 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 $ FFI.upCast i+ 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 $ FFI.upCast i+ 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 $ FFI.upCast i+ 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 $ FFI.upCast i+ 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 $ FFI.upCast i+ 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 $ FFI.upCast i+ return' i A.LandingPad { A.type' = t, A.personalityFunction = pf,@@ -458,13 +462,13 @@ when cl $ do cl <- encodeM cl liftIO $ FFI.setCleanup i cl- return $ FFI.upCast i+ 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 $ FFI.upCast i+ return' i A.Load { A.volatile = vol, A.address = a,@@ -477,7 +481,7 @@ vol <- encodeM vol (ss, mo) <- encodeM mat i <- liftIO $ FFI.buildLoad builder a' al vol mo ss s- return $ FFI.upCast i+ return' i A.Store { A.volatile = vol, A.address = a, @@ -492,7 +496,7 @@ vol <- encodeM vol (ss, mo) <- encodeM mat i <- liftIO $ FFI.buildStore builder v' a' al vol mo ss s- return $ FFI.upCast i+ return' i A.GetElementPtr { A.address = a, A.indices = is, A.inBounds = ib } -> do a' <- encodeM a (n, is') <- encodeM is@@ -500,11 +504,11 @@ when ib $ do ib <- encodeM ib liftIO $ FFI.setInBounds i ib- return $ FFI.upCast i+ return' i A.Fence { A.atomicity = at } -> do (ss, mo) <- encodeM at i <- liftIO $ FFI.buildFence builder mo ss s- return $ FFI.upCast i+ return' i A.CmpXchg { A.volatile = vol, A.address = a, A.expected = e, A.replacement = r,@@ -517,7 +521,7 @@ vol <- encodeM vol (ss, mo) <- encodeM at i <- liftIO $ FFI.buildCmpXchg builder a' e' r' vol mo ss s- return $ FFI.upCast i+ return' i A.AtomicRMW { A.volatile = vol, A.rmwOperation = rmwOp,@@ -532,7 +536,7 @@ vol <- encodeM vol (ss, mo) <- encodeM at i <- liftIO $ FFI.buildAtomicRMW builder rmwOp a' v' vol mo ss s- return $ FFI.upCast i+ return' i o -> $( let fieldData :: String -> [Either TH.ExpQ TH.ExpQ]@@ -584,7 +588,7 @@ let s = TH.nameBase f, Right action <- fieldData s ] ++ [- TH.noBindS [| return $ FFI.upCast $(TH.dyn "i") |]+ TH.noBindS [| return' $(TH.dyn "i") |] ] ) ]@@ -610,5 +614,15 @@ liftIO $ FFI.setValueName v n' defineLocal n v return i++instance EncodeM EncodeAST a (Ptr FFI.Instruction, EncodeAST ()) => EncodeM EncodeAST (A.Named a) (EncodeAST ()) where+ encodeM (A.Do o) = liftM snd $ (encodeM o :: EncodeAST (Ptr FFI.Instruction, EncodeAST ()))+ encodeM (n A.:= o) = do+ (i, later) <- encodeM o+ let v = FFI.upCast (i :: Ptr FFI.Instruction)+ n' <- encodeM n+ liftIO $ FFI.setValueName v n'+ defineLocal n v+ return later
src/LLVM/General/Internal/Module.hs view
@@ -42,6 +42,7 @@ import LLVM.General.Internal.Operand import LLVM.General.Internal.Type import LLVM.General.Internal.Value+import LLVM.General.Internal.Instruction () import LLVM.General.Diagnostic @@ -68,6 +69,7 @@ moduleString :: Module -> IO String moduleString (Module m) = bracket (FFI.getModuleAssembly m) free $ decodeM +-- | generate LLVM bitcode from a 'Module' writeBitcodeToFile :: FilePath -> Module -> IO () writeBitcodeToFile path (Module m) = flip runAnyContT return $ do msgPtr <- alloca@@ -190,11 +192,15 @@ liftIO $ FFI.addAttribute p attrs return () return ()- forInterleavedM blocks $ \(A.BasicBlock bName namedInstrs term) -> do+ finishInstrs <- forInterleavedM blocks $ \(A.BasicBlock bName namedInstrs term) -> do b <- encodeM bName- (do builder <- gets encodeStateBuilder; liftIO $ FFI.positionBuilderAtEnd builder b)- (mapM encodeM namedInstrs :: EncodeAST [Ptr FFI.Instruction])- encodeM term :: EncodeAST (Ptr FFI.Instruction)+ (do+ builder <- gets encodeStateBuilder+ liftIO $ FFI.positionBuilderAtEnd builder b)+ finishes <- mapM encodeM namedInstrs :: EncodeAST [EncodeAST ()]+ (encodeM term :: EncodeAST (Ptr FFI.Instruction))+ return (sequence_ finishes)+ sequence_ finishInstrs return (FFI.upCast f) setLinkage g' (A.G.linkage g) setVisibility g' (A.G.visibility g)
test/LLVM/General/Test/Module.hs view
@@ -250,7 +250,58 @@ ] ] t <- withModuleFromAST context ast $ \_ -> return True- t @?= Right True+ t @?= Right True,++ testCase "Phi node finishes" $ withContext $ \context -> do+ let ast = Module "<string>" 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))) []+ )+ ]+ ]+ s = "; ModuleID = '<string>'\n\+ \\n\+ \define i32 @foo(i32 %x) {\n\+ \ %1 = mul nsw i32 %x, %x\n\+ \ br label %here\n\+ \\n\+ \here: ; preds = %0\n\+ \ %2 = phi i32 [ 42, %0 ]\n\+ \ br label %elsewhere\n\+ \\n\+ \elsewhere: ; preds = %here\n\+ \ br label %there\n\+ \\n\+ \there: ; preds = %elsewhere\n\+ \ ret i32 %1\n\+ \}\n"+ strCheck ast s ], testGroup "failures" [
test/LLVM/General/Test/Tests.hs view
@@ -13,7 +13,6 @@ import qualified LLVM.General.Test.Optimization as Optimization import qualified LLVM.General.Test.Target as Target - tests = testGroup "llvm-general" [ Constants.tests, DataLayout.tests,