diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +## 9.0.0 (2019-09-06) + +* The functions in `LLVM.IRBuilder.Constant` no longer return a + monadic context. To recover the previous behavior use `pure`. (Thanks to @jfaure) +* `LLVM.IRBuilder.Instruction.globalStringPtr` returns a `Constant` + instead of an `Operand`. (Thanks to @jfaure) +* Fresh name generation in the IRBuilder should be significantly faster (Thanks to @luc-tielen) +* Update to LLVM 9.0 + * The `MainSubprogram` constructor from `DIFlag` has been removed + and a few new flags have been added. + ## 8.0.0 (2019-03-10) * Upgrade to LLVM 8 diff --git a/llvm-hs-pure.cabal b/llvm-hs-pure.cabal --- a/llvm-hs-pure.cabal +++ b/llvm-hs-pure.cabal @@ -1,5 +1,5 @@ name: llvm-hs-pure -version: 8.0.0 +version: 9.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -16,13 +16,13 @@ llvm-hs-pure is a set of pure Haskell types and functions for interacting with LLVM . It includes an ADT to represent LLVM IR (). The llvm-hs package builds on this one with FFI bindings to LLVM, but llvm-hs-pure does not require LLVM to be available. -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.4 +tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 extra-source-files: CHANGELOG.md source-repository head type: git location: git://github.com/llvm-hs/llvm-hs.git - branch: llvm-8 + branch: llvm-9 library default-language: Haskell2010 diff --git a/src/LLVM/AST/Constant.hs b/src/LLVM/AST/Constant.hs --- a/src/LLVM/AST/Constant.hs +++ b/src/LLVM/AST/Constant.hs @@ -9,6 +9,7 @@ import LLVM.AST.Name import LLVM.AST.FloatingPointPredicate (FloatingPointPredicate) import LLVM.AST.IntegerPredicate (IntegerPredicate) +import LLVM.AST.AddrSpace ( AddrSpace(..) ) import qualified LLVM.AST.Float as F {- | @@ -236,3 +237,11 @@ unsignedIntegerValue (Int nBits bits) = bits .&. (complement (-1 `shiftL` (fromIntegral nBits))) unsignedIntegerValue _ = error "unsignedIntegerValue is only defined for Int" + +-- platform independant sizeof: a gep to the end of a nullptr and some bitcasting. +sizeof :: Type -> Constant +sizeof t = PtrToInt szPtr (IntegerType 32) + where + ptrType = PointerType t (AddrSpace 0) + nullPtr = IntToPtr (Int 32 0) ptrType + szPtr = GetElementPtr True nullPtr [Int 32 1] diff --git a/src/LLVM/AST/Operand.hs b/src/LLVM/AST/Operand.hs --- a/src/LLVM/AST/Operand.hs +++ b/src/LLVM/AST/Operand.hs @@ -146,7 +146,15 @@ | IntroducedVirtual | BitField | NoReturn - | MainSubprogram + | ArgumentNotModified + | TypePassByValue + | TypePassByReference + | EnumClass + | Thunk + | NonTrivial + | BigEndian + | LittleEndian + | AllCallsDescribed deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) data DIMacroInfo = Define | Undef diff --git a/src/LLVM/AST/ParameterAttribute.hs b/src/LLVM/AST/ParameterAttribute.hs --- a/src/LLVM/AST/ParameterAttribute.hs +++ b/src/LLVM/AST/ParameterAttribute.hs @@ -17,6 +17,7 @@ | ReadNone | ReadOnly | WriteOnly + | ImmArg | InAlloca | NonNull | Dereferenceable Word64 diff --git a/src/LLVM/IRBuilder/Constant.hs b/src/LLVM/IRBuilder/Constant.hs --- a/src/LLVM/IRBuilder/Constant.hs +++ b/src/LLVM/IRBuilder/Constant.hs @@ -7,29 +7,26 @@ import LLVM.AST.Constant import LLVM.AST.Float -int64 :: Applicative f => Integer -> f Operand -int64 = pure . ConstantOperand . Int 64 - -int32 :: Applicative f => Integer -> f Operand -int32 = pure . ConstantOperand . Int 32 - -int8 :: Applicative f => Integer -> f Operand -int8 = pure . ConstantOperand . Int 8 - -bit :: Applicative f => Integer -> f Operand -bit = pure . ConstantOperand . Int 1 +int64 :: Integer -> Operand +int64 = ConstantOperand . Int 64 +int32 :: Integer -> Operand +int32 = ConstantOperand . Int 32 +int8 :: Integer -> Operand +int8 = ConstantOperand . Int 8 +bit :: Integer -> Operand +bit = ConstantOperand . Int 1 -double :: Applicative f => Double -> f Operand -double = pure . ConstantOperand . Float . Double +double :: Double -> Operand +double = ConstantOperand . Float . Double -single :: Applicative f => Float -> f Operand -single = pure . ConstantOperand . Float . Single +single :: Float -> Operand +single = ConstantOperand . Float . Single -half :: Applicative f => Word16 -> f Operand -half = pure . ConstantOperand . Float . Half +half :: Word16 -> Operand +half = ConstantOperand . Float . Half -struct :: Applicative f => Maybe Name -> Bool -> [Constant] -> f Operand -struct nm packing members = pure . ConstantOperand $ Struct nm packing members +struct :: Maybe Name -> Bool -> [Constant] -> Operand +struct nm packing members = ConstantOperand $ Struct nm packing members -array :: Applicative f => [Constant] -> f Operand -array members = pure . ConstantOperand $ Array (typeOf $ head members) members +array :: [Constant] -> Operand +array members = ConstantOperand $ Array (typeOf $ head members) members diff --git a/src/LLVM/IRBuilder/Instruction.hs b/src/LLVM/IRBuilder/Instruction.hs --- a/src/LLVM/IRBuilder/Instruction.hs +++ b/src/LLVM/IRBuilder/Instruction.hs @@ -296,10 +296,10 @@ -- | Creates a series of instructions to generate a pointer to a string -- constant. Useful for making format strings to pass to @printf@, for example globalStringPtr - :: (MonadModuleBuilder m, MonadIRBuilder m) + :: (MonadModuleBuilder m) => String -- ^ The string to generate -> Name -- ^ Variable name of the pointer - -> m Operand + -> m C.Constant globalStringPtr str nm = do let asciiVals = map (fromIntegral . ord) str llvmVals = map (C.Int 8) (asciiVals ++ [0]) -- append null terminator @@ -315,9 +315,6 @@ , initializer = Just charArray , unnamedAddr = Just GlobalAddr } - emitInstr charStar GetElementPtr - { inBounds = True - , address = ConstantOperand $ C.GlobalReference (ptr ty) nm - , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] - , AST.metadata = [] - } + return $ C.GetElementPtr True + (C.GlobalReference (ptr ty) nm) + [(C.Int 32 0), (C.Int 32 0)] diff --git a/src/LLVM/IRBuilder/Monad.hs b/src/LLVM/IRBuilder/Monad.hs --- a/src/LLVM/IRBuilder/Monad.hs +++ b/src/LLVM/IRBuilder/Monad.hs @@ -32,8 +32,8 @@ import Data.Bifunctor import Data.String -import Data.HashSet(HashSet) -import qualified Data.HashSet as HS +import Data.Map.Strict(Map) +import qualified Data.Map.Strict as M import LLVM.AST @@ -78,7 +78,7 @@ -- | Builder monad state data IRBuilderState = IRBuilderState { builderSupply :: !Word - , builderUsedNames :: !(HashSet ShortByteString) + , builderUsedNames :: !(Map ShortByteString Word) , builderNameSuggestion :: !(Maybe ShortByteString) , builderBlocks :: SnocList BasicBlock , builderBlock :: !(Maybe PartialBlock) @@ -154,9 +154,10 @@ freshName suggestion = do usedNames <- liftIRState $ gets builderUsedNames let - candidates = suggestion : [suggestion <> fromString (show n) | n <- [(1 :: Int)..]] - (unusedName:_) = filter (not . (`HS.member` usedNames)) candidates - liftIRState $ modify $ \s -> s { builderUsedNames = HS.insert unusedName $ builderUsedNames s } + nameCount = fromMaybe 0 $ M.lookup suggestion usedNames + unusedName = suggestion <> fromString ("_" <> show nameCount) + updatedUsedNames = M.insert suggestion (nameCount + 1) usedNames + liftIRState $ modify $ \s -> s { builderUsedNames = updatedUsedNames } return $ Name unusedName -- | Generate a fresh numbered name diff --git a/test/LLVM/Test/IRBuilder.hs b/test/LLVM/Test/IRBuilder.hs --- a/test/LLVM/Test/IRBuilder.hs +++ b/test/LLVM/Test/IRBuilder.hs @@ -28,18 +28,18 @@ [ GlobalDefinition functionDefaults { name = "add", parameters = - ( [ Parameter AST.i32 "a" [] - , Parameter AST.i32 "b" [] + ( [ Parameter AST.i32 "a_0" [] + , Parameter AST.i32 "b_0" [] ] , False ), returnType = AST.i32, basicBlocks = [ BasicBlock - "entry" + "entry_0" [ UnName 0 := Add { - operand0 = LocalReference AST.i32 "a", - operand1 = LocalReference AST.i32 "b", + operand0 = LocalReference AST.i32 "a_0", + operand1 = LocalReference AST.i32 "b_0", nsw = False, nuw = False, metadata = [] @@ -65,29 +65,29 @@ name = "foo", returnType = AST.double, basicBlocks = - [ BasicBlock (UnName 0) [ "xxx" := fadd f10 f10] + [ BasicBlock (UnName 0) [ "xxx_0" := fadd f10 f10] (Do (Ret Nothing [])) , BasicBlock - "blk" + "blk_0" [ UnName 1 := fadd f10 f10 , UnName 2 := fadd (LocalReference AST.double (UnName 1)) (LocalReference AST.double (UnName 1)) , UnName 3 := add (ConstantOperand (C.Int 32 10)) (ConstantOperand (C.Int 32 10)) ] - (Do (Br "blk1" [])) + (Do (Br "blk_1" [])) , BasicBlock - "blk1" - [ "c" := fadd f10 f10 - , UnName 4 := fadd (LocalReference AST.double "c") (LocalReference AST.double "c") + "blk_1" + [ "c_0" := fadd f10 f10 + , UnName 4 := fadd (LocalReference AST.double "c_0") (LocalReference AST.double "c_0") ] - (Do (Br "blk2" [])) + (Do (Br "blk_2" [])) , BasicBlock - "blk2" - [ "phi" := + "blk_2" + [ "phi_0" := Phi AST.double - [ ( f10, "blk" ) - , ( f10, "blk1" ) - , ( f10, "blk2" ) + [ ( f10, "blk_0" ) + , ( f10, "blk_1" ) + , ( f10, "blk_2" ) ] [] , UnName 5 := fadd f10 f10 @@ -112,9 +112,9 @@ name = "baz", parameters = ( [ Parameter AST.i32 (UnName 0) [] - , Parameter AST.double "arg" [] + , Parameter AST.double "arg_0" [] , Parameter AST.i32 (UnName 1) [] - , Parameter AST.double "arg1" []] + , Parameter AST.double "arg_1" []] , False), returnType = AST.double, basicBlocks = @@ -132,11 +132,11 @@ (Do (Br (UnName 4) [])) , BasicBlock (UnName 4) - [ "arg2" := fadd (LocalReference AST.double "arg") f10 - , UnName 5 := fadd (LocalReference AST.double "arg2") (LocalReference AST.double "arg2") + [ "arg_2" := fadd (LocalReference AST.double "arg_0") f10 + , UnName 5 := fadd (LocalReference AST.double "arg_2") (LocalReference AST.double "arg_2") , UnName 6 := Select { condition' = ConstantOperand (C.Int 1 0), - trueValue = LocalReference AST.double "arg2", + trueValue = LocalReference AST.double "arg_2", falseValue = LocalReference AST.double (UnName 5), metadata = [] } @@ -177,16 +177,16 @@ [ GlobalDefinition functionDefaults { returnType = AST.i32 , name = Name "f" - , parameters = ([Parameter AST.i32 "a" []], False) + , parameters = ([Parameter AST.i32 "a_0" []], False) , basicBlocks = - [ BasicBlock (Name "entry") + [ BasicBlock (Name "entry_0") [ UnName 0 := Call { tailCallKind = Nothing , callingConvention = CC.C , returnAttributes = [] , I.function = Right (ConstantOperand (C.GlobalReference (AST.ptr (FunctionType AST.i32 [AST.i32] False)) (Name "f"))) - , arguments = [(LocalReference (IntegerType {typeBits = 32}) (Name "a"),[])] + , arguments = [(LocalReference (IntegerType {typeBits = 32}) (Name "a_0"),[])] , functionAttributes = [] , metadata = [] } @@ -259,29 +259,29 @@ [ TypeDefinition "pair" (Just (StructureType False [AST.i32, AST.i32])) , GlobalDefinition functionDefaults { name = "f" - , parameters = ( [ Parameter (AST.ptr (NamedTypeReference "pair")) "ptr" [] - , Parameter AST.i32 "x" [] - , Parameter AST.i32 "y" []] + , parameters = ( [ Parameter (AST.ptr (NamedTypeReference "pair")) "ptr_0" [] + , Parameter AST.i32 "x_0" [] + , Parameter AST.i32 "y_0" []] , False) , returnType = AST.void , basicBlocks = [ BasicBlock (UnName 0) [ UnName 1 := GetElementPtr { inBounds = False - , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr" + , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr_0" , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] , metadata = [] } , UnName 2 := GetElementPtr { inBounds = False - , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr" + , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr_0" , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] , metadata = [] } , Do $ Store { volatile = False , address = LocalReference (AST.ptr AST.i32) (UnName 1) - , value = LocalReference AST.i32 "x" + , value = LocalReference AST.i32 "x_0" , maybeAtomicity = Nothing , alignment = 0 , metadata = [] @@ -289,7 +289,7 @@ , Do $ Store { volatile = False , address = LocalReference (AST.ptr AST.i32) (UnName 2) - , value = LocalReference AST.i32 "y" + , value = LocalReference AST.i32 "y_0" , maybeAtomicity = Nothing , alignment = 0 , metadata = [] @@ -375,7 +375,7 @@ let mallocTy = AST.ptr $ AST.FunctionType (AST.ptr AST.i8) [AST.i64] False function "omg" [] (AST.void) $ \_ -> do - size <- int64 10 + let size = int64 10 call (ConstantOperand $ C.GlobalReference mallocTy "malloc") [(size, [])] unreachable where