packages feed

llvm-tf 12.0 → 12.0.0.1

raw patch · 5 files changed

+26/−22 lines, 5 files

Files

llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name:          llvm-tf-Version:       12.0+Version:       12.0.0.1 License:       BSD3 License-File:  LICENSE Synopsis:      Bindings to the LLVM compiler toolkit using type families.@@ -37,7 +37,7 @@   Location: http://code.haskell.org/~thielema/llvm-tf/  Source-Repository this-  Tag:      12.0+  Tag:      12.0.0.1   Type:     darcs   Location: http://code.haskell.org/~thielema/llvm-tf/
private/LLVM/Core/CodeGen.hs view
@@ -475,12 +475,12 @@     String -> (String -> CodeGenModule FFI.ValueRef) ->     CodeGenFunction r (Value ptr) externCore name act = do-    es <- getExterns-    case lookup name es of+    mf <- lookupExtern name+    case mf of         Just f -> return $ Value f         Nothing -> do             f <- liftCodeGenModule $ act name-            putExterns ((name, f) : es)+            addExtern name f             return $ Value f  {- |
private/LLVM/Core/CodeGenMonad.hs view
@@ -6,7 +6,8 @@     GlobalMappings(..), addGlobalMapping, getGlobalMappings,     addFunctionMapping,     -- * Function code generation-    CodeGenFunction, runCodeGenFunction, liftCodeGenModule, genFSym, getFunction, getBuilder, getFunctionModule, getExterns, putExterns,+    CodeGenFunction, runCodeGenFunction, liftCodeGenModule, genFSym,+    getFunction, getBuilder, getFunctionModule, lookupExtern, addExtern,     ) where  import qualified LLVM.Core.Data as Data@@ -23,6 +24,9 @@ import Control.Monad.IO.Class (MonadIO, liftIO, ) import Control.Monad (when, ) import Control.Applicative (Applicative, )++import qualified Data.Map as Map+import Data.Map (Map) import Data.Monoid (Monoid, mempty, mappend, ) import Data.Semigroup (Semigroup, (<>), ) @@ -32,7 +36,7 @@  data CGMState = CGMState {     cgm_module :: Module,-    cgm_externs :: [(String, Function)],+    cgm_externs :: Map String Function,     cgm_global_mappings :: GlobalMappings,     cgm_next :: !Int     }@@ -55,7 +59,7 @@     evalStateT body $     CGMState {         cgm_module = m, cgm_next = 1,-        cgm_externs = [], cgm_global_mappings = mempty+        cgm_externs = Map.empty, cgm_global_mappings = mempty     }  --------------------------------------@@ -86,14 +90,14 @@ getFunctionModule :: CodeGenFunction a Module getFunctionModule = CGF $ gets (cgm_module . cgf_module) -getExterns :: CodeGenFunction a [(String, Function)]-getExterns = CGF $ gets (cgm_externs . cgf_module)+lookupExtern :: String -> CodeGenFunction a (Maybe Function)+lookupExtern name = CGF $ gets (Map.lookup name . cgm_externs . cgf_module) -putExterns :: [(String, Function)] -> CodeGenFunction a ()-putExterns es = do-    cgf <- CGF get-    let cgm' = (cgf_module cgf) { cgm_externs = es }-    CGF $ put (cgf { cgf_module = cgm' })+addExtern :: String -> Function -> CodeGenFunction a ()+addExtern name func = CGF $ modify $ \cgf ->+    cgf {cgf_module = (cgf_module cgf)+            {cgm_externs =+                Map.insert name func (cgm_externs $ cgf_module cgf) } }   type Value = FFI.ValueRef
private/LLVM/Core/Instructions.hs view
@@ -562,7 +562,7 @@ -- |Acceptable arguments to 'extractvalue' and 'insertvalue'. class GetValue agg ix where     type ValueType agg ix-    getIx :: LP.Proxy agg -> ix -> CUInt+    getIx :: proxy agg -> ix -> CUInt  instance (GetField as i, Dec.Natural i) => GetValue (Struct as) (Proxy i) where     type ValueType (Struct as) (Proxy i) = FieldType as i@@ -592,11 +592,11 @@              => Value agg                   -- ^ Aggregate              -> i                           -- ^ Index into the aggregate              -> CodeGenFunction r (Value (ValueType agg i))-extractvalue (Value agg) i =+extractvalue v@(Value agg) i =     liftM Value $     withCurrentBuilder $ \ bldPtr ->       U.withEmptyCString $-        FFI.buildExtractValue bldPtr agg (getIx (LP.Proxy :: LP.Proxy agg) i)+        FFI.buildExtractValue bldPtr agg (getIx v i)  -- | Insert a value into an aggregate, nondestructive. insertvalue :: forall r agg i.@@ -605,11 +605,11 @@             -> Value (ValueType agg i)     -- ^ Value to insert             -> i                           -- ^ Index into the aggregate             -> CodeGenFunction r (Value agg)-insertvalue (Value agg) (Value e) i =+insertvalue v@(Value agg) (Value e) i =     liftM Value $     withCurrentBuilder $ \ bldPtr ->       U.withEmptyCString $-        FFI.buildInsertValue bldPtr agg e (getIx (LP.Proxy :: LP.Proxy agg) i)+        FFI.buildInsertValue bldPtr agg e (getIx v i)   --------------------------------------
src/LLVM/Util/Arithmetic.hs view
@@ -238,14 +238,14 @@  instance (Value a ~ b) => ToArithFunction r (IO a) (CodeGenFunction r b) where     type TFunA (CodeGenFunction r b) = IO (UnValue b)-    type TFunB r (IO a) = CodeGenFunction r (Value a)+    type TFunB r (IO a) = TValue r a     toArithFunction' cl = runCall =<< cl  instance     (ToArithFunction r b0 b1, CodeGenFunction r (Value a0) ~ a1) =>         ToArithFunction r (a0 -> b0) (a1 -> b1) where     type TFunA (a1 -> b1) = UnValue (CodeValue a1) -> TFunA b1-    type TFunB r (a0 -> b0) = CodeGenFunction r (Value a0) -> TFunB r b0+    type TFunB r (a0 -> b0) = TValue r a0 -> TFunB r b0     toArithFunction' cl x =         toArithFunction' (liftM2 applyCall cl x)