llvm-tf 3.0.3.1.1 → 3.0.3.1.2
raw patch · 3 files changed
+37/−22 lines, 3 files
Files
- example/Vector.hs +8/−4
- llvm-tf.cabal +2/−2
- src/LLVM/Core/Util.hs +27/−16
example/Vector.hs view
@@ -21,19 +21,23 @@ -- Number of vector elements. type N = D16 +retAccName, fName :: String+retAccName = "retacc"+fName = "vectest"+ cgvec :: CodeGenModule (Function (T -> IO T)) cgvec = do -- A global variable that vectest messes with. acc <- createNamedGlobal False ExternalLinkage "acc" (constOf (0 :: T)) -- Return the global variable.- retAcc <- createNamedFunction ExternalLinkage "retacc" $ do+ retAcc <- createNamedFunction ExternalLinkage retAccName $ do vacc <- load acc ret vacc let _ = retAcc :: Function (IO T) -- Force the type of retAcc. -- A function that tests vector operations.- f <- createNamedFunction ExternalLinkage "vectest" $ \ x -> do+ f <- createNamedFunction ExternalLinkage fName $ \ x -> do let v = value (zero :: ConstValue (Vector N T)) n = Dec.integralFromSingleton (Dec.singleton :: Dec.Singleton N) :: Word32@@ -87,9 +91,9 @@ print $ map fst funcs let iovec' :: Function (T -> IO T)- Just iovec' = castModuleValue =<< lookup "vectest" funcs+ Just iovec' = castModuleValue =<< lookup fName funcs ioretacc' :: Function (IO T)- Just ioretacc' = castModuleValue =<< lookup "retacc" funcs+ Just ioretacc' = castModuleValue =<< lookup retAccName funcs (vec', retacc') <- runEngineAccess $ do addModule m
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name: llvm-tf-Version: 3.0.3.1.1+Version: 3.0.3.1.2 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: 3.0.3.1.1+ Tag: 3.0.3.1.2 Type: darcs Location: http://code.haskell.org/~thielema/llvm-tf/
src/LLVM/Core/Util.hs view
@@ -33,7 +33,8 @@ CString, withArrayLen, withEmptyCString, functionType, buildEmptyPhi, addPhiIns,- showTypeOf, getValueNameU, getObjList, annotateValueList, isConstant,+ showTypeOf, getValueNameU, getObjList, annotateValueList,+ isConstant, isIntrinsic, -- * Transformation passes addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass, addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,@@ -57,7 +58,7 @@ import Data.Typeable (Typeable) import Data.List (intercalate)-import Control.Monad (liftM, filterM, when)+import Control.Monad (liftM, when) type Type = FFI.TypeRef@@ -142,10 +143,14 @@ return (fs ++ gs) getFunctions :: Module -> IO [(String, Value)]-getFunctions mdl = getObjList withModule FFI.getFirstFunction FFI.getNextFunction mdl >>= filterM isIntrinsic >>= annotateValueList+getFunctions mdl =+ getObjList withModule FFI.getFirstFunction FFI.getNextFunction mdl+ >>= annotateValueList getGlobalVariables :: Module -> IO [(String, Value)]-getGlobalVariables mdl = getObjList withModule FFI.getFirstGlobal FFI.getNextGlobal mdl >>= annotateValueList+getGlobalVariables mdl =+ getObjList withModule FFI.getFirstGlobal FFI.getNextGlobal mdl+ >>= annotateValueList -- This is safe because we just ask for the type of a value. valueHasType :: Value -> Type -> Bool@@ -241,7 +246,9 @@ FFI.appendBasicBlock func namePtr getBasicBlocks :: Value -> IO [(String, Value)]-getBasicBlocks v = getObjList withValue FFI.getFirstBasicBlock FFI.getNextBasicBlock v >>= annotateValueList+getBasicBlocks v =+ getObjList withValue FFI.getFirstBasicBlock FFI.getNextBasicBlock v+ >>= annotateValueList -------------------------------------- @@ -259,7 +266,9 @@ getParam f = unsafePerformIO . FFI.getParam f . fromIntegral getParams :: Value -> IO [(String, Value)]-getParams v = getObjList withValue FFI.getFirstParam FFI.getNextParam v >>= annotateValueList+getParams v =+ getObjList withValue FFI.getFirstParam FFI.getNextParam v+ >>= annotateValueList -------------------------------------- @@ -322,7 +331,9 @@ return i getInstructions :: Value -> IO [(String, Value)]-getInstructions bb = getObjList withValue FFI.getFirstInstruction FFI.getNextInstruction bb >>= annotateValueList+getInstructions bb =+ getObjList withValue FFI.getFirstInstruction FFI.getNextInstruction bb+ >>= annotateValueList getOperands :: Value -> IO [(String, Value)] getOperands ii = geto ii >>= annotateValueList@@ -437,16 +448,16 @@ str <- peekCString cs if str == "" then return (show a) else return str -getObjList :: (t1 -> (t2 -> IO [Ptr a]) -> t) -> (t2 -> IO (Ptr a))- -> (Ptr a -> IO (Ptr a)) -> t1 -> t-getObjList withF firstF nextF obj = do+getObjList ::+ (obj -> (objPtr -> IO [Ptr a]) -> io) -> (objPtr -> IO (Ptr a)) ->+ (Ptr a -> IO (Ptr a)) -> obj -> io+getObjList withF firstF nextF obj = withF obj $ \ objPtr -> do- ofst <- firstF objPtr - let oloop p = if p == nullPtr then return [] else do- n <- nextF p- ps <- oloop n- return (p : ps)- oloop ofst+ let oloop p =+ if p == nullPtr+ then return []+ else fmap (p:) $ oloop =<< nextF p+ oloop =<< firstF objPtr annotateValueList :: [Value] -> IO [(String, Value)] annotateValueList vs = do