llvm-hs-pure 6.2.1 → 7.0.0

raw patch · 7 files changed

+191/−16 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• llvm-hs-pure.cabal +2/−2
• src/LLVM/AST/Operand.hs +15/−6
• src/LLVM/IRBuilder/Instruction.hs +14/−4
• src/LLVM/IRBuilder/Module.hs +72/−4
• src/LLVM/IRBuilder/Monad.hs +12/−0
• test/LLVM/Test/IRBuilder.hs +59/−0

@@ -1,3 +1,20 @@+## 7.0.0 (2018-09-28)++* Track type definitions in `MonadModuleBuilder`. This allows us to+  automatically resolve `NamedTypeReference`s in `gep` instructions.+  Note that type definitions must be defined before they are used+  (i.e. `MonadFix` will not behave correctly here).+* Change the type of `gep` in the `IRBuilder` API to require a+  `MonadModuleBuilder` constraint.+* Change the type of `typedef` in the `IRBuilder` API to return a+  `NamedTypeReference` to the newly defined type.+* Update for LLVM 7.0:+  * Add `isUnsigned` field to `DIEnumerator`.+  * Change `DISubrange` to use the new `DICount` type instead of an `Int64`.+  * Merge `checksum` and `checksumKind` fields of `DIFile` into a+    `checksum` field of type `Maybe ChecksumInfo`.+  * Rename the `variables` field of `DISubprogram` to `retainedNodes`.+ ## 6.2.1 (2018-06-12)  * Fix type of `shuffleVector` in the IRBuilder API.

@@ -1,5 +1,5 @@ name: llvm-hs-pure-version: 6.2.1+version: 7.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer <moritz.kiefer@purelyfunctional.org>, Benjamin S. Scarlet@@ -22,7 +22,7 @@ source-repository head   type: git   location: git://github.com/llvm-hs/llvm-hs.git-  branch: llvm-5+  branch: llvm-7  library   default-language: Haskell2010

@@ -195,14 +195,19 @@  -- | <https://llvm.org/docs/LangRef.html#dienumerator> data DIEnumerator =-  Enumerator { value :: Int64, name :: ShortByteString }+  Enumerator { value :: Int64, isUnsigned :: Bool, name :: ShortByteString }   deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | <https://llvm.org/docs/LangRef.html#disubrange> data DISubrange =-  Subrange { count :: Int64, lowerBound :: Int64 }+  Subrange { count :: DICount, lowerBound :: Int64 }   deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +data DICount+  = DICountConstant Int64+  | DICountVariable (MDRef DIVariable)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)+ -- | <https://llvm.org/doxygen/classllvm_1_1DIScope.html> data DIScope   = DICompileUnit DICompileUnit@@ -255,11 +260,15 @@ data DIFile = File   { filename :: ShortByteString   , directory :: ShortByteString-  , checksum :: ShortByteString-  , checksumKind :: ChecksumKind+  , checksum :: Maybe ChecksumInfo   } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) -data ChecksumKind = None | MD5 | SHA1+data ChecksumInfo = ChecksumInfo+  { checksumKind :: ChecksumKind+  , checksumValue :: ShortByteString+  } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)++data ChecksumKind = MD5 | SHA1   deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | <https://llvm.org/doxygen/classllvm_1_1DILocalScope.html>@@ -288,7 +297,7 @@   , unit :: Maybe (MDRef DICompileUnit)   , templateParams :: [MDRef DITemplateParameter]   , declaration :: Maybe (MDRef DISubprogram)-  , variables :: [MDRef DILocalVariable]+  , retainedNodes :: [MDRef DILocalVariable]   , thrownTypes :: [MDRef DIType]   } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) 

@@ -4,6 +4,8 @@  import Prelude hiding (and, or, pred) +import Control.Monad.State (gets)+import qualified Data.Map.Lazy as Map import Data.Word  import LLVM.AST hiding (args, dests)@@ -17,6 +19,7 @@ import qualified LLVM.AST.FloatingPointPredicate as FP  import LLVM.IRBuilder.Monad+import LLVM.IRBuilder.Module  fadd :: MonadIRBuilder m => Operand -> Operand -> m Operand fadd a b = emitInstr (typeOf a) $ FAdd noFastMathFlags a b []@@ -82,18 +85,25 @@ store :: MonadIRBuilder m => Operand -> Word32 -> Operand -> m () store addr align val = emitInstrVoid $ Store False addr val Nothing align [] -gep :: MonadIRBuilder m => Operand -> [Operand] -> m Operand-gep addr is = emitInstr (gepType (typeOf addr) is) (GetElementPtr False addr is [])+gep :: (MonadIRBuilder m, MonadModuleBuilder m) => Operand -> [Operand] -> m Operand+gep addr is = do+  ty <- gepType (typeOf addr) is+  emitInstr ty (GetElementPtr False addr is [])   where     -- TODO: Perhaps use the function from llvm-hs-pretty (https://github.com/llvm-hs/llvm-hs-pretty/blob/master/src/LLVM/Typed.hs)-    gepType :: Type -> [Operand] -> Type-    gepType ty [] = ptr ty+    gepType :: MonadModuleBuilder m => Type -> [Operand] -> m Type+    gepType ty [] = pure (ptr ty)     gepType (PointerType ty _) (_:is') = gepType ty is'     gepType (StructureType _ elTys) (ConstantOperand (C.Int 32 val):is') =       gepType (elTys !! fromIntegral val) is'     gepType (StructureType _ _) (i:_) = error $ "gep: Indices into structures should be 32-bit constants. " ++ show i     gepType (VectorType _ elTy) (_:is') = gepType elTy is'     gepType (ArrayType _ elTy) (_:is') = gepType elTy is'+    gepType (NamedTypeReference nm) is' = do+      mayTy <- liftModuleState (gets (Map.lookup nm . builderTypeDefs))+      case mayTy of+        Nothing -> error $ "gep: Couldn’t resolve typedef for: " ++ show nm+        Just ty -> gepType ty is'     gepType t (_:_) = error $ "gep: Can't index into a " ++ show t  trunc :: MonadIRBuilder m => Operand -> Type -> m Operand

@@ -36,6 +36,9 @@ import Data.ByteString.Short as BS import Data.Char import Data.Data+import Data.Foldable+import Data.Map.Lazy (Map)+import qualified Data.Map.Lazy as Map import Data.String  import GHC.Generics(Generic)@@ -44,6 +47,7 @@ import LLVM.AST.Global import LLVM.AST.Linkage import LLVM.AST.Type (ptr)+import qualified LLVM.AST.Typed import qualified LLVM.AST.Constant as C  import LLVM.IRBuilder.Internal.SnocList@@ -58,13 +62,15 @@ instance MonadFail m => MonadFail (ModuleBuilderT m) where   fail str = ModuleBuilderT (StateT $ \_ -> Fail.fail str) -newtype ModuleBuilderState = ModuleBuilderState+data ModuleBuilderState = ModuleBuilderState   { builderDefs :: SnocList Definition+  , builderTypeDefs :: Map Name Type   }  emptyModuleBuilder :: ModuleBuilderState emptyModuleBuilder = ModuleBuilderState   { builderDefs = mempty+  , builderTypeDefs = mempty   }  type ModuleBuilder = ModuleBuilderT Identity@@ -81,6 +87,8 @@ instance Monad m => MonadModuleBuilder (ModuleBuilderT m) where   liftModuleState (StateT s) = ModuleBuilderT $ StateT $ pure . runIdentity . s ++ -- | Evaluate 'ModuleBuilder' to a result and a list of definitions runModuleBuilder :: ModuleBuilderState -> ModuleBuilder a -> (a, [Definition]) runModuleBuilder s m = runIdentity $ runModuleBuilderT s m@@ -160,15 +168,73 @@   let funty = ptr $ FunctionType retty argtys False   pure $ ConstantOperand $ C.GlobalReference funty nm +-- | An external variadic argument function definition+externVarArgs +  :: MonadModuleBuilder m+  => Name   -- ^ Definition name+  -> [Type] -- ^ Parameter types+  -> Type   -- ^ Type+  -> m Operand+externVarArgs nm argtys retty = do+  emitDefn $ GlobalDefinition functionDefaults+    { name        = nm+    , linkage     = External+    , parameters  = ([Parameter ty (mkName "") [] | ty <- argtys], True)+    , returnType  = retty+    }+  let funty = ptr $ FunctionType retty argtys True+  pure $ ConstantOperand $ C.GlobalReference funty nm++-- | A global variable definition+global+  :: MonadModuleBuilder m+  => Name       -- ^ Variable name+  -> Type       -- ^ Type+  -> C.Constant -- ^ Initializer+  -> m Operand+global nm ty initVal = do+  emitDefn $ GlobalDefinition globalVariableDefaults+    { name                  = nm+    , LLVM.AST.Global.type' = ty+    , linkage               = External+    , initializer           = Just initVal+    }+  pure $ ConstantOperand $ C.GlobalReference (ptr ty) nm++-- | 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+  => String       -- ^ The string to generate+  -> Name         -- ^ Variable name of the pointer+  -> m Operand+globalStringPtr str nm = do+  let asciiVals = map (fromIntegral . ord) str+      llvmVals  = map (C.Int 8) (asciiVals ++ [0]) -- append null terminator+      char      = IntegerType 8+      charStar  = ptr char+      charArray = C.Array char llvmVals+  emitDefn $ GlobalDefinition globalVariableDefaults+    { name                  = nm+    , LLVM.AST.Global.type' = LLVM.AST.Typed.typeOf charArray+    , linkage               = External+    , isConstant            = True+    , initializer           = Just charArray+    , unnamedAddr           = Just GlobalAddr+    }+  pure $ ConstantOperand $ C.BitCast (C.GlobalReference charStar nm) charStar+ -- | A named type definition typedef   :: MonadModuleBuilder m   => Name   -> Maybe Type-  -> m ()+  -> m Type typedef nm ty = do   emitDefn $ TypeDefinition nm ty-  pure ()+  for_ ty $ \ty' ->+    liftModuleState (modify (\s -> s { builderTypeDefs = Map.insert nm ty' (builderTypeDefs s) }))+  pure (NamedTypeReference nm)  -- | Convenience function for module construction buildModule :: ShortByteString -> ModuleBuilder a -> Module@@ -200,4 +266,6 @@ instance MonadModuleBuilder m => MonadModuleBuilder (StateT s m) instance MonadModuleBuilder m => MonadModuleBuilder (Strict.StateT s m) instance (Monoid w, MonadModuleBuilder m) => MonadModuleBuilder (Strict.WriterT w m)-instance (Monoid w, MonadModuleBuilder m) => MonadModuleBuilder (Lazy.WriterT w m)++-- Not an mtl instance, but necessary in order for @globalStringPtr@ to compile+instance MonadModuleBuilder m => MonadModuleBuilder (IRBuilderT m)

@@ -262,6 +262,18 @@     Just n -> pure n     Nothing -> error "Called currentBlock when no block was active" +-- | Find out if the currently active block has a terminator.+--+-- This function will fail under the same condition as @currentBlock@+hasTerminator :: MonadIRBuilder m => m Bool+hasTerminator = do+  current <- liftIRState $ gets builderBlock+  case current of+    Nothing    -> error "Called hasTerminator when no block was active"+    Just blk -> case partialBlockTerm blk of+      Nothing  -> return False+      Just _   -> return True+ ------------------------------------------------------------------------------- -- mtl instances -------------------------------------------------------------------------------

@@ -52,6 +52,7 @@         }       , testCase "calls constant globals" callWorksWithConstantGlobals       , testCase "supports recursive function calls" recursiveFunctionCalls+      , testCase "resolves typefes" resolvesTypeDefs       , testCase "builds the example" $ do         let f10 = ConstantOperand (C.Float (F.Double 10))             fadd a b = FAdd { operand0 = a, operand1 = b, fastMathFlags = noFastMathFlags, metadata = [] }@@ -240,6 +241,64 @@         }       ]     }++resolvesTypeDefs :: Assertion+resolvesTypeDefs = do+  buildModule "<string>" builder @?= ast+  where builder = mdo+          pairTy <- typedef "pair" (Just (StructureType False [AST.i32, AST.i32]))+          function "f" [(AST.ptr pairTy, "ptr"), (AST.i32, "x"), (AST.i32, "y")] AST.void $ \[ptr, x, y] -> do+            xPtr <- gep ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)]+            yPtr <- gep ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)]+            store xPtr 0 x+            store yPtr 0 y+          pure ()+        ast = defaultModule+          { moduleName = "<string>"+          , moduleDefinitions =+            [ 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" []]+                             , False)+              , returnType = AST.void+              , basicBlocks =+                [ BasicBlock (UnName 0)+                  [ UnName 1 := GetElementPtr+                      { inBounds = False+                      , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr"+                      , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)]+                      , metadata = []+                      }+                  , UnName 2 := GetElementPtr+                      { inBounds = False+                      , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr"+                      , 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"+                      , maybeAtomicity = Nothing+                      , alignment = 0+                      , metadata = []+                      }+                  , Do $ Store+                      { volatile = False+                      , address = LocalReference (AST.ptr AST.i32) (UnName 2)+                      , value = LocalReference AST.i32 "y"+                      , maybeAtomicity = Nothing+                      , alignment = 0+                      , metadata = []+                      }+                  ]+                  (Do (Ret Nothing []))+                ]+              }+            ]}  simple :: Module simple = buildModule "exampleModule" $ mdo