knead 0.2 → 0.2.0.1
raw patch · 4 files changed
+53/−41 lines, 4 filesdep +transformersdep ~llvm-extradep ~llvm-tf
Dependencies added: transformers
Dependency ranges changed: llvm-extra, llvm-tf
Files
- knead.cabal +5/−4
- src/Data/Array/Knead/Code.hs +24/−14
- src/Data/Array/Knead/Parameterized/Physical.hs +16/−15
- src/Data/Array/Knead/Simple/Physical.hs +8/−8
knead.cabal view
@@ -1,5 +1,5 @@ Name: knead-Version: 0.2+Version: 0.2.0.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -47,7 +47,7 @@ Build-Type: Simple Source-Repository this- Tag: 0.2+ Tag: 0.2.0.1 Type: darcs Location: http://hub.darcs.net/thielema/knead/ @@ -57,10 +57,11 @@ Library Build-Depends:- llvm-extra >=0.6 && <0.7,- llvm-tf >=3.0.3 && <3.0.4,+ llvm-extra >=0.6 && <0.8,+ llvm-tf >=3.1 && <3.2, storable-tuple >=0.0 && <0.1, storable-record >=0.0.3 && <0.1,+ transformers >=0.3 && <0.6, utility-ht >=0.0.1 && <0.1, base >=4 && <5
src/Data/Array/Knead/Code.hs view
@@ -4,17 +4,19 @@ import qualified Data.Array.Knead.Index.Nested.Shape as Shape import qualified LLVM.Extra.Multi.Value as MultiValue-import qualified LLVM.Extra.Execution as Exec import qualified LLVM.ExecutionEngine as EE import qualified LLVM.Util.Optimize as Opt import qualified LLVM.Core as LLVM -import Foreign.Ptr (Ptr, )+import Foreign.Ptr (Ptr, FunPtr, ) import Control.Monad (void, liftM2, when, )+import Control.Applicative ((<$>), ) +import Data.Functor.Compose (Compose(Compose)) + getElementPtr :: (Shape.C sh, Shape.Index sh ~ ix) => MultiValue.T sh -> LLVM.Value (Ptr a) ->@@ -25,22 +27,30 @@ LLVM.getElementPtr ptr (n, ()) -compile ::- (Exec.Compile funcs) =>- String ->- LLVM.CodeGenModule (Exec.LLVMFunction funcs) ->- IO funcs-compile name bld = do+compile :: String -> Exec funcs -> IO funcs+compile name (Compose bld) = do LLVM.initializeNativeTarget m <- LLVM.newModule (funcs, mappings) <-- LLVM.defineModule m $- liftM2 (,) bld LLVM.getGlobalMappings+ LLVM.defineModule m $ do+ LLVM.setTarget LLVM.hostTriple+ liftM2 (,) bld LLVM.getGlobalMappings LLVM.writeBitcodeToFile (name ++ ".bc") m when False $ do void $ Opt.optimizeModule 3 m LLVM.writeBitcodeToFile (name ++ "-opt.bc") m- EE.runEngineAccess $- EE.addModule m >>- EE.addGlobalMappings mappings >>- Exec.compile funcs+ EE.runEngineAccessWithModule m $+ EE.addGlobalMappings mappings >> funcs+++type Exec = Compose LLVM.CodeGenModule EE.EngineAccess+type Importer f = FunPtr f -> f++createFunction ::+ (EE.ExecutionFunction f, LLVM.FunctionArgs f) =>+ Importer f -> String -> LLVM.FunctionCodeGen f -> Exec f+createFunction importer name f =+ Compose $+ EE.getExecutionFunction importer+ <$>+ LLVM.createNamedFunction LLVM.ExternalLinkage name f
src/Data/Array/Knead/Parameterized/Physical.hs view
@@ -18,6 +18,7 @@ import qualified Data.Array.Knead.Parameter as Param import qualified Data.Array.Knead.Index.Nested.Shape as Shape import qualified Data.Array.Knead.Expression as Expr+import qualified Data.Array.Knead.Code as Code import Data.Array.Knead.Expression (Exp, unExp, ) import Data.Array.Knead.Code (getElementPtr, compile, ) @@ -36,7 +37,7 @@ import Control.Exception (bracket, ) import Control.Monad.HT (void, (<=<), )-import Control.Monad (liftM2, )+import Control.Applicative (liftA2, ) import Data.Tuple.HT (mapFst, ) import Data.Word (Word32, ) @@ -75,7 +76,7 @@ the (Sym.Array arr create delete) = do func <- compile "the" $- LLVM.createNamedFunction LLVM.ExternalLinkage "eval" $+ Code.createFunction callThe "eval" $ \paramPtr resultPtr -> do param <- Memory.load paramPtr case arr param of@@ -85,7 +86,7 @@ bracket (create p) (delete . fst) $ \(_ctx, param) -> with param $ \pptr -> alloca $ \aptr ->- callThe func (MultiValueMemory.castStructPtr pptr) (MultiValueMemory.castStructPtr aptr) >>+ func (MultiValueMemory.castStructPtr pptr) (MultiValueMemory.castStructPtr aptr) >> peek aptr @@ -103,7 +104,7 @@ renderShape (Sym.Array arr create delete) = do fsh <- compile "renderShape" $- LLVM.createNamedFunction LLVM.ExternalLinkage "shape" $+ Code.createFunction callShaper "shape" $ \paramPtr resultPtr -> do param <- Memory.load paramPtr case arr param of@@ -117,7 +118,7 @@ with param $ \pptr -> do let lpptr = MultiValueMemory.castStructPtr pptr let lshptr = MultiValueMemory.castStructPtr shptr- n <- callShaper fsh lpptr lshptr+ n <- fsh lpptr lshptr sh <- peek shptr return (sh, n) @@ -129,8 +130,8 @@ render (Sym.Array arr create delete) = do (fsh, farr) <- compile "render" $- liftM2 (,)- (LLVM.createNamedFunction LLVM.ExternalLinkage "shape" $+ liftA2 (,)+ (Code.createFunction callShaper "shape" $ \paramPtr resultPtr -> do param <- Memory.load paramPtr case arr param of@@ -138,7 +139,7 @@ sh <- unExp esh MultiValueMemory.store sh resultPtr Shape.sizeCode sh >>= LLVM.ret)- (LLVM.createNamedFunction LLVM.ExternalLinkage "fill" $+ (Code.createFunction callRenderer "fill" $ \paramPtr shapePtr bufferPtr -> do param <- Memory.load paramPtr case arr param of@@ -154,10 +155,10 @@ with param $ \pptr -> do let lpptr = MultiValueMemory.castStructPtr pptr let lshptr = MultiValueMemory.castStructPtr shptr- n <- callShaper fsh lpptr lshptr+ n <- fsh lpptr lshptr fptr <- mallocForeignPtrArray (fromIntegral n) withForeignPtr fptr $- callRenderer farr lpptr lshptr . MultiValueMemory.castStructPtr+ farr lpptr lshptr . MultiValueMemory.castStructPtr sh <- peek shptr return (Phys.Array sh fptr) @@ -180,8 +181,8 @@ (fsh, farr) <- compile "scatter" $- liftM2 (,)- (LLVM.createNamedFunction LLVM.ExternalLinkage "shape" $+ liftA2 (,)+ (Code.createFunction callShaper "shape" $ \paramPtr resultPtr -> do param <- Memory.load paramPtr case arrBase param of@@ -189,7 +190,7 @@ sh <- unExp esh MultiValueMemory.store sh resultPtr Shape.sizeCode sh >>= LLVM.ret)- (LLVM.createNamedFunction LLVM.ExternalLinkage "fill" $+ (Code.createFunction callScatterer "fill" $ \paramBasePtr paramMapPtr shapePtr bufferPtr -> do paramBase <- Memory.load paramBasePtr paramMap <- Memory.load paramMapPtr@@ -219,10 +220,10 @@ let paramBaseMVPtr = MultiValueMemory.castStructPtr paramBasePtr let paramMapMVPtr = MultiValueMemory.castStructPtr paramMapPtr let shapeMVPtr = MultiValueMemory.castStructPtr shptr- n <- callShaper fsh paramBaseMVPtr shapeMVPtr+ n <- fsh paramBaseMVPtr shapeMVPtr fptr <- mallocForeignPtrArray (fromIntegral n) withForeignPtr fptr $- callScatterer farr paramBaseMVPtr paramMapMVPtr shapeMVPtr .+ farr paramBaseMVPtr paramMapMVPtr shapeMVPtr . MultiValueMemory.castStructPtr sh <- peek shptr return (Phys.Array sh fptr)
src/Data/Array/Knead/Simple/Physical.hs view
@@ -16,6 +16,7 @@ import qualified Data.Array.Knead.Simple.Private as Sym import qualified Data.Array.Knead.Index.Nested.Shape as Shape import qualified Data.Array.Knead.Expression as Expr+import qualified Data.Array.Knead.Code as Code import Data.Array.Knead.Expression (Exp, unExp, ) import Data.Array.Knead.Code (getElementPtr, compile, ) @@ -35,7 +36,7 @@ import Foreign.Ptr (FunPtr, Ptr, ) import Control.Monad.HT (void, )-import Control.Monad (liftM2, )+import Control.Applicative (liftA2, ) import Data.Word (Word32, ) import Prelude hiding (scanl1, )@@ -110,17 +111,16 @@ alloca $ \shptr -> do (fsh, farr) <- compile name $- liftM2 (,)- (LLVM.createNamedFunction LLVM.ExternalLinkage "shape" $ \ptr -> do+ liftA2 (,)+ (Code.createFunction callShaper "shape" $ \ptr -> do sh <- unExp esh MultiValueMemory.store sh ptr Shape.sizeCode sh >>= LLVM.ret)- (LLVM.createNamedFunction LLVM.ExternalLinkage "fill" code)+ (Code.createFunction callRenderer "fill" code) let lshptr = MultiValueMemory.castStructPtr shptr- n <- callShaper fsh lshptr+ n <- fsh lshptr fptr <- mallocForeignPtrArray (fromIntegral n)- withForeignPtr fptr $- callRenderer farr lshptr . MultiValueMemory.castStructPtr+ withForeignPtr fptr $ farr lshptr . MultiValueMemory.castStructPtr sh <- peek shptr return (Array sh fptr) @@ -152,7 +152,7 @@ acc1 <- Maybe.run macc0 (return a) (flip (Expr.unliftM2 f) a) flip Memory.store ptr0 acc1 ptrK1 <-- liftM2 (,)+ liftA2 (,) (A.advanceArrayElementPtr ptr0) (A.inc k0) return (ptrK1, Maybe.just acc1)