Paraiso (empty) → 0.0.0.0
raw patch · 24 files changed
+2071/−0 lines, 24 filesdep +basedep +containersdep +control-monad-failuresetup-changed
Dependencies added: base, containers, control-monad-failure, directory, fgl, filepath, mtl, numeric-prelude, repa
Files
- LICENSE +30/−0
- Language/Paraiso.hs +10/−0
- Language/Paraiso/Failure.hs +14/−0
- Language/Paraiso/Generator.hs +35/−0
- Language/Paraiso/Generator/Allocation.hs +3/−0
- Language/Paraiso/Generator/Cpp.hs +677/−0
- Language/Paraiso/Interval.hs +40/−0
- Language/Paraiso/Name.hs +43/−0
- Language/Paraiso/OM/Arithmetic.hs +98/−0
- Language/Paraiso/OM/Builder.hs +17/−0
- Language/Paraiso/OM/Builder/Boolean.hs +73/−0
- Language/Paraiso/OM/Builder/Internal.hs +343/−0
- Language/Paraiso/OM/DynValue.hs +27/−0
- Language/Paraiso/OM/Graph.hs +115/−0
- Language/Paraiso/OM/Realm.hs +39/−0
- Language/Paraiso/OM/Reduce.hs +16/−0
- Language/Paraiso/OM/Value.hs +35/−0
- Language/Paraiso/Orthotope.hs +23/−0
- Language/Paraiso/POM.hs +57/−0
- Language/Paraiso/PiSystem.hs +27/−0
- Language/Paraiso/Prelude.hs +43/−0
- Language/Paraiso/Tensor.hs +160/−0
- Paraiso.cabal +144/−0
- Setup.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Takayuki Muranushi++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Takayuki Muranushi nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/Paraiso.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS -Wall #-}++-- | Paraiso main module.+-- I think adding this will expose source for run?++module Language.Paraiso (run) where++-- | Generate Wonderful Program+run :: () -> String+run _ = "#include <iostream>\nint main () {cout << \"hello\" << endl;}\n"
+ Language/Paraiso/Failure.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS -Wall #-}++-- | a module for handling failure+module Language.Paraiso.Failure+ (+ module Control.Monad.Failure, unsafePerformFailure+ ) where++import Control.Monad.Failure+import System.IO.Unsafe++unsafePerformFailure :: IO a -> a+unsafePerformFailure = unsafePerformIO+
+ Language/Paraiso/Generator.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}+{-# OPTIONS -Wall #-}+-- | a general code generator definition.+module Language.Paraiso.Generator+ (+ Generator(..), Symbolable(..)+ ) where++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring+import Language.Paraiso.Failure+import Language.Paraiso.POM+import Language.Paraiso.Tensor (Vector)++-- | The definition for code generator.+class Generator gen where+ -- | The data that is daughter of gen; describes the code generation strategy.+ data Strategy gen :: *+ -- | Code generation.+ generate :: (Vector v, Ring.C g, Additive.C (v g), Ord (v g), Symbolable gen g) =>+ gen -- ^The code generator.+ -> POM v g (Strategy gen) -- ^The 'POM' sourcecode, annotated with 'Strategy'.+ -> FilePath -- ^The directory name under which the files are to be generated.+ -> IO () -- ^The act of generation.++-- | The translation of Haskell symbols to other languages.+class (Generator gen) => Symbolable gen a where+ -- | Failure handling version of symbol translation.+ symbolF :: (Failure StringException f) =>+ gen -- ^The 'Generator'.+ -> a -- ^A Haskell object to be translated.+ -> f String -- ^The translation result which may fail.+ -- | Pure version, which may emit runtime error.+ symbol :: gen -> a -> String+ symbol gen0 a0 = unsafePerformFailure (symbolF gen0 a0)
+ Language/Paraiso/Generator/Allocation.hs view
@@ -0,0 +1,3 @@+{-# OPTIONS -Wall #-}+module Language.Paraiso.Generator.Allocation(Allocation(..)) where+data Allocation = Manifest | Delayed | Auto deriving (Eq, Show)
+ Language/Paraiso/Generator/Cpp.hs view
@@ -0,0 +1,677 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, + MultiParamTypeClasses, NoImplicitPrelude,+ TypeFamilies #-}+{-# OPTIONS -Wall #-}+-- | a generic code generator definition.+module Language.Paraiso.Generator.Cpp+ (+ module Language.Paraiso.Generator,+ Cpp(..), autoStrategy, decideStrategy+ ) where++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring+import Control.Monad.State (State)+import qualified Control.Monad.State as State+import Data.Dynamic (Dynamic, Typeable, TypeRep, fromDynamic, typeOf)+import qualified Data.Graph.Inductive as FGL+import qualified Data.List as List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (fromJust, listToMaybe)+import Language.Paraiso.Failure +import Language.Paraiso.Generator+import qualified Language.Paraiso.Generator.Allocation as Alloc+import qualified Language.Paraiso.OM.Arithmetic as A+import Language.Paraiso.OM.DynValue as DVal+import Language.Paraiso.OM.Graph+import Language.Paraiso.OM.Realm (Realm(..))+import qualified Language.Paraiso.OM.Reduce as Reduce+import Language.Paraiso.Prelude+import Language.Paraiso.POM as POM+import Language.Paraiso.Tensor+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))++-- | The c++ code generator.+data Cpp = Cpp deriving (Eq, Show)++autoStrategy :: Strategy Cpp+autoStrategy = CppStrategy Alloc.Auto++instance Generator Cpp where+ data Strategy Cpp = CppStrategy { + allocStrategy :: Alloc.Allocation + } deriving (Eq, Show)+ + generate _ pom0 path = do+ let + pom1 = decideStrategy pom0+ members = makeMembers pom1+ headerFn = nameStr pom1 ++ ".hpp"+ cppFn = nameStr pom1 ++ ".cpp"+ createDirectoryIfMissing True path+ writeFile (path </> headerFn) $ genHeader members pom1+ writeFile (path </> cppFn) $ genCpp headerFn members pom1+++{---- -----}+{---- Translations of names, symbols, types and values -----}+{---- -----}++instance Symbolable Cpp Int where+ symbolF Cpp x = return (show x)++instance Symbolable Cpp Dynamic where+ symbolF Cpp dyn = let+ ret = msum $ map ($dyn) dynamicDB+ in case ret of+ Just str -> return str+ Nothing -> failure $ StringException $ + "Cpp cannot translate symbol of type: " ++ show dyn+ +instance Symbolable Cpp TypeRep where+ symbolF Cpp tr = let+ ret = msum $ map ($tr) typeRepDB+ in case ret of+ Just str -> return str+ Nothing -> failure $ StringException $ + "Cpp cannot translate type: " ++ show tr+ ++instance Symbolable Cpp DVal.DynValue where+ symbolF Cpp dyn0 = do+ let+ container :: String -> String+ container = case DVal.realm dyn0 of+ Global -> id+ Local -> ("std::vector<"++).(++">")+ type0 <- symbolF Cpp $ DVal.typeRep dyn0+ return $ container type0++instance Symbolable Cpp Name where+ symbolF Cpp = return . nameStr+ +-- | The databeses for Haskell -> Cpp immediate values translations.+dynamicDB:: [Dynamic -> Maybe String]+dynamicDB = map fst symbolDB++-- | The databeses for Haskell -> Cpp type name translations.+typeRepDB:: [TypeRep -> Maybe String]+typeRepDB = map snd symbolDB++symbolDB:: [(Dynamic -> Maybe String, TypeRep -> Maybe String)]+symbolDB = [ + add "bool" (\x->if x then "true" else "false"),+ add "int" (show::Int->String), + add "long long int" (show::Integer->String), + add "float" ((++"f").show::Float->String), + add "double" (show::Double->String)+ ] + where+ add :: (Typeable a) => String -> (a->String) + -> (Dynamic -> Maybe String, TypeRep -> Maybe String)+ add = add' undefined+ add' :: (Typeable a) => a -> String -> (a->String) + -> (Dynamic -> Maybe String, TypeRep -> Maybe String)+ add' dummy typename f = + (fmap f . fromDynamic, + \tr -> if tr==typeOf dummy then Just typename else Nothing)++{---- -----}+{---- Make decisions on code generation strategies -----}+{---- -----}++decideStrategy :: (Vector v, Ring.C g) => + POM v g (Strategy Cpp)+ -> POM v g (Strategy Cpp)+decideStrategy = POM.mapGraph dSGraph+ where+ dSGraph :: (Vector v, Ring.C g) => + Graph v g (Strategy Cpp)+ -> Graph v g (Strategy Cpp)+ dSGraph graph = FGL.gmap + (\(pre,n,lab,suc) -> (pre,n,fmap (modify graph n) lab,suc)) graph++ modify :: (Vector v, Ring.C g) => + Graph v g (Strategy Cpp) + -> FGL.Node+ -> Strategy Cpp+ -> Strategy Cpp+ modify graph n (CppStrategy alloc) = CppStrategy alloc'+ where+ alloc' = if alloc /= Alloc.Auto + then alloc+ else decideAlloc graph n+ decideAlloc :: (Vector v, Ring.C g) => + Graph v g (Strategy Cpp) + -> FGL.Node+ -> Alloc.Allocation+ decideAlloc graph n = + if isGlobal || afterLoad || isStore + || beforeReduce || afterReduce + || (False &&( beforeShift && afterShift))+ then Alloc.Manifest+ else Alloc.Delayed+ where+ self0 = FGL.lab graph n+ pre0 = FGL.lab graph =<<(listToMaybe $ FGL.pre graph n) + suc0 = FGL.lab graph =<<(listToMaybe $ FGL.suc graph n) + isGlobal = case self0 of+ Just (NValue (DVal.DynValue Global _) _) -> True+ _ -> False+ afterLoad = case pre0 of+ Just (NInst (Load _) _) -> True+ _ -> False+ isStore = case self0 of+ Just (NInst (Store _) _) -> True+ _ -> False+ beforeReduce = case suc0 of+ Just (NInst (Reduce _) _) -> True+ _ -> False+ afterReduce = case pre0 of+ Just (NInst (Reduce _) _) -> True+ _ -> False++ beforeShift = case suc0 of+ Just (NInst (Shift _) _) -> True+ _ -> False+ afterShift = case pre0 of+ Just (NInst (Shift _) _) -> True+ _ -> False+++{---- -----}+{---- c++ class header generation -----}+{---- -----}++-- | Access type of c++ class members+data AccessType = ReadWrite | ReadInit | ReadDepend String++data CMember = CMember {accessType :: AccessType, memberDV :: (Named DynValue)}++instance Nameable CMember where+ name = name . memberDV+++sizeName :: Name+sizeName = Name "size"+sizeNameCall :: String+sizeNameCall = (++"()") . nameStr $ sizeName++sizeForAxis :: (Vector v) => Axis v -> Name+sizeForAxis axis = Name $ "size" ++ show (axisIndex axis)+sizeForAxisCall :: (Vector v) => Axis v -> String+sizeForAxisCall = (++"()") . nameStr . sizeForAxis+ +++ +fglNodeName :: FGL.Node -> Name +fglNodeName n = Name $ "a" ++ show n+++makeMembers :: (Vector v, Ring.C g) => POM v g a -> [CMember]+makeMembers pom = [sizeMember] ++ sizeAMembers ++ map (CMember ReadWrite) vals + where+ vals = staticValues $ POM.setup pom++ f :: (Vector v, Ring.C g) => POM v g a -> v CMember+ f _ = compose (\axis -> CMember ReadInit (Named (sizeForAxis axis) globalInt))++ sizeMember :: CMember+ sizeMember = CMember (ReadDepend $ "return " ++ prod ++ ";") (Named sizeName globalInt)+ globalInt = DynValue Global (typeOf (undefined::Int))++ sizeAMembers :: [CMember]+ sizeAMembers = foldMap (:[]) $ f pom+ + prod :: String+ prod = concat $ List.intersperse " * " $ map (\m -> nameStr m ++ "()") sizeAMembers++genHeader :: (Vector v, Ring.C g) => [CMember] -> POM v g a -> String+genHeader members pom = unlines[+ commonInclude ,+ "class " ++ nameStr pom ++ "{",+ decStr,+ readerStr,+ writerStr,+ "public:",+ constructorStr,+ kernelStr,+ "};"+ ]+ where+ declare (Named name0 dyn0) =+ symbol Cpp dyn0 ++ " " ++ symbol Cpp name0 ++ "_;"+ decStr = unlines $ ("private:" :) $ concat $ + (flip map) members $ + (\mem -> case accessType mem of+ ReadDepend _ -> []+ _ -> [declare $ memberDV mem])++ reader (ref',code) (Named name0 dyn0) =+ let name1 = symbol Cpp name0 in+ "const " ++ symbol Cpp dyn0 ++ " " ++ ref' ++ name1 ++ "() const { " ++ code name1 ++" }"+ readerCode n = "return " ++ n ++ "_ ;"+ readerStr = unlines $ ("public:" :) $ concat $ + (flip map) members $ + (\(CMember at dv) -> case at of+ ReadDepend s -> [reader ("" ,const s) dv]+ _ -> [reader ("&",readerCode) dv])++ writer (ref',code) (Named name0 dyn0) =+ let name1 = symbol Cpp name0 in+ symbol Cpp dyn0 ++ " " ++ ref' ++ name1 ++ "() { " ++ code name1 ++" }"+ writerCode n = "return " ++ n ++ "_ ;"+ writerStr = unlines $ ("public:" :) $ concat $ + (flip map) members $ + (\(CMember at dv) -> case at of+ ReadWrite -> [writer ("&" ,writerCode) dv]+ _ -> [])++ initializer (Named name0 _) = let name1 = symbol Cpp name0 in+ name1 ++ "_(" ++ name1 ++ ")"+ initializeIfLocal (Named name0 dyn0) = let name1 = symbol Cpp name0 in+ if DVal.realm dyn0 == Global+ then []+ else [name1 ++ "_(" ++ sizeNameCall ++ ")"]+ initializerStr = concat $ List.intersperse "," $ concat $+ (flip map) members $ + (\(CMember at dv) -> case at of+ ReadInit -> [initializer dv]+ ReadWrite -> initializeIfLocal dv+ _ -> [])+ cArg (Named name0 dyn0) = let name1 = symbol Cpp name0 in+ symbol Cpp dyn0 ++ " " ++ name1+ cArgStr = concat $ List.intersperse "," $ concat $+ (flip map) members $ + (\(CMember at dv) -> case at of+ ReadInit -> [cArg dv]+ _ -> [])+ constructorStr = nameStr pom ++ " ( " ++ cArgStr ++ " ): " + ++ initializerStr ++ "{}"+ + kernelStr = unlines $ map (\kernel -> "void " ++ nameStr kernel ++ " ();") $+ kernels pom+++commonInclude :: String+commonInclude = unlines[+ "#include <algorithm>", + "#include <cmath>",+ "#include <vector>",+ ""+ ]++{---- -----}+{---- c++ kernel generating tools -----}+{---- -----}++-- | A representation for Addressed Single Static Assignment.+data Cursor v g = + -- | node number and shift+ CurLocal { cursorToFGLNode :: FGL.Node, cursorToShift :: (v g)} |+ -- | node number + CurGlobal { cursorToFGLNode :: FGL.Node }+ deriving (Eq, Ord)++instance Show (Cursor v g) where+ show (CurLocal n _) = "/*L " ++ show n ++ "*/"+ show (CurGlobal n ) = "/*G " ++ show n ++ "*/"+ + +data Context = + CtxGlobal |+ CtxLocal Name -- ^The name of the indexing variable.+ deriving (Eq, Ord, Show)++type BindingMap v g= Map (Cursor v g) String+data BinderState v g = BinderState { + context :: Context,+ graphCtx :: Graph v g (Strategy Cpp),+ bindings :: BindingMap v g+ } deriving (Show)++type Binder v g a = State (BinderState v g) a+ +data HandSide = LeftHand | RightHand deriving (Eq, Show)++paren :: String -> String+paren x = "(" ++ x ++ ")"++arithRep :: A.Operator -> [String] -> String+arithRep op = let+ unary symb [x] = paren $ unwords [symb,x]+ unary symb _ = error $ symb ++ "is not a unary operator!"+ infx symb [x,y] = paren $ unwords [x,symb,y]+ infx symb _ = error $ symb ++ "is not a binary operator, can't be infix!"+ func symb xs = symb ++ paren (List.concat $ List.intersperse "," xs)+ err = error $ "unsupported operator : " ++ show op+ selectMaker [x,y,z] = paren $ unwords [x,"?",y,":",z]+ selectMaker _ = error "select requires exactly 3 arguments."+ in case op of+ A.Add -> infx "+"+ A.Sub -> infx "-"+ A.Neg -> unary "-"+ A.Mul -> infx "*" + A.Div -> infx "/" + A.Inv -> unary "1/"+ A.Not -> unary "!"+ A.And -> infx "&&" + A.Or -> infx "||" + A.EQ -> infx "==" + A.NE -> infx "!=" + A.LT -> infx "<" + A.LE -> infx "<=" + A.GT -> infx ">" + A.GE -> infx ">=" + A.Max -> func "max"+ A.Min -> func "min"+ A.Abs -> func "abs"+ A.Signum -> err+ A.Select -> selectMaker+ A.Ipow -> func "pow"+ A.Pow -> func "pow"+ A.Madd -> err+ A.Msub -> err+ A.Nmadd -> err+ A.Nmsub -> err+ A.Sqrt -> func "sqrt"+ A.Exp -> func "exp"+ A.Log -> func "log"+ A.Sin -> func "sin"+ A.Cos -> func "cos"+ A.Tan -> func "tan"+ A.Asin -> func "asin"+ A.Acos -> func "acos"+ A.Atan -> func "atan"+ A.Sincos -> err+ +++runBinder :: (Additive.C (v g)) =>+ Graph v g (Strategy Cpp) -> FGL.Node -> (Cursor v g -> Binder v g ()) -> String+runBinder graph0 n0 binder = unlines $ header ++ [bindStr] ++ footer+ where + rlm = lhsRealm graph0 n0+ bindStr = unlines $ Map.elems $ bindings state+ state = snd $ State.runState (binder iniCur) ini+ + iniCur = case rlm of+ Global -> CurGlobal n0+ Local -> CurLocal n0 Additive.zero+ ini = BinderState {+ context = case rlm of + Global -> CtxGlobal+ Local -> CtxLocal $ Name "i",+ graphCtx = graph0,+ bindings = Map.empty+ }+ + (header,footer) = case context state of+ CtxGlobal -> ([],[])+ CtxLocal loopIndex -> ([loop (symbol Cpp loopIndex) ++ " {"], ["}"])+ loop i =+ "for (int " ++ i ++ " = 0 ; " + ++ i ++ " < " ++ symbol Cpp sizeName ++ "() ; " + ++ "++" ++ i ++ ")"+++reduceBinder :: (Additive.C (v g), Ord (v g), Symbolable Cpp g, Vector v) =>+ Reduce.Operator+ -> FGL.Node+ -> FGL.Node+ -> Binder v g String+reduceBinder op nInst nSrc = do+ graph <- bindersGraph+ let+ reduceCursor = CurGlobal nInst+ reducerName = "reduce_" ++ show nInst;+ srcNode = fromJust $ FGL.lab graph nSrc+ srcType = case srcNode of+ NValue dyn0 _ -> dyn0{DVal.realm = Global}+ NInst _ _ -> error "cannot reduce over NInst"+ srcCursor = CurLocal nSrc Additive.zero+ fun = arithRep $ Reduce.toArith op+ i = "i"+ rhs0 <- withLocalContext (Name "0") $ rightHandSide srcCursor+ rhs <- withLocalContext (Name i ) $ rightHandSide srcCursor+ bindingModify $ Map.insert reduceCursor $ unlines[+ symbol Cpp srcType ++ " " ++ reducerName ++ " = " ++ rhs0 ++ ";", + "for (int " ++ i ++ " = 1 ; " + ++ i ++ " < " ++ sizeNameCall ++ "; " + ++ "++" ++ i ++ ") {",+ reducerName ++ " = "++ fun [reducerName,rhs] ++ ";",+ "}"]+ return reducerName+++lhsRealm :: Graph v g (Strategy Cpp) -> FGL.Node -> Realm +lhsRealm graph n = + case fromJust $ FGL.lab graph n of + NValue dyn0 _ -> DVal.realm dyn0+ NInst inst _ -> + case inst of+ Store _ -> lhsRealm graph $ head $ FGL.pre graph n+ _ -> undefined+++bindersGraph :: Binder v g (Graph v g (Strategy Cpp))+bindersGraph = fmap graphCtx State.get++bindersContext :: Binder v g Context+bindersContext = fmap context State.get++bindersMap :: Binder v g (BindingMap v g)+bindersMap = fmap bindings State.get+++bindingModify :: (BindingMap v g -> BindingMap v g) -> Binder v g ()+bindingModify f = do+ s <- State.get+ m <- bindersMap+ State.put s{bindings = f m}++cursorToNode :: (Cursor v g) -> Binder v g (Node v g (Strategy Cpp))+cursorToNode cur = do+ graph <- bindersGraph+ return $ fromJust $ FGL.lab graph $ cursorToFGLNode cur++withLocalContext :: Name -> Binder v g a -> Binder v g a+withLocalContext name0 binder0 = do+ state0 <- State.get+ ctx0 <- bindersContext+ State.put state0{context = CtxLocal name0}+ ret <- binder0+ state1 <- State.get+ State.put state1{context = ctx0}+ return ret++-- | add @cursor@ in the current binding, if missing.+addBinding :: (Vector v, Symbolable Cpp g, Additive.C (v g), Ord (v g)) => + Cursor v g+ -> Binder v g ()+addBinding cursor = do + graph <- bindersGraph+ m <- bindersMap+ if Map.member cursor m+ then return ()+ else do+ lhs <- leftHandSide cursor+ let+ -- any Node that has well-defined LHS must have one and only one pre Node.+ preNode = head $ FGL.pre graph(cursorToFGLNode cursor)+ preCursor = cursor{cursorToFGLNode = preNode}+ rhs <- rightHandSide preCursor+ bindingModify $ Map.insert cursor (lhs ++ " = " ++ rhs ++ ";")+++cursorToSymbol :: (Vector v, Symbolable Cpp g, Additive.C (v g), Ord (v g)) =>+ HandSide+ -> Cursor v g + -> Binder v g String+cursorToSymbol side cur = do+ node <- cursorToNode cur+ ctx <- bindersContext + case (cur,ctx) of+ (CurGlobal _, _) -> return $ makeName0 True node undefined undefined+ (_,CtxGlobal ) -> return $ makeName0 True node undefined undefined+ (_,CtxLocal i ) -> do+ let axer = \(ax, shiftAmount) -> do+ idxStr <- rhsLoadIndex ax+ return (ax, (idxStr, shiftAmount)) + axes3 <- traverse axer $ compose (\ax -> (ax, cursorToShift cur!ax))+ return $ makeName0 False node axes3 i+ where+ makeName0 isG node axes3 i0 = if isG then nameStr name0 else prefix ++ nameStr name0 ++ suffix i0+ where+ name0 = case node of+ NValue _ _ -> fglNodeName $ cursorToFGLNode cur+ NInst inst _ -> case inst of+ Store name1 -> Name $ (++ "()") $ nameStr name1+ Load name1 -> Name $ (++ "()") $ nameStr name1+ _ -> error $ "this Inst does not have symbol" + typeDelayed = case node of+ NValue dyn0 _ -> symbol Cpp dyn0{DVal.realm = Global}+ _ -> error "no type"+ alloc = allocStrategy $ getA node + prefix = if side == LeftHand && alloc == Alloc.Delayed + then "const " ++ typeDelayed ++ " " else ""+ isManifest = case alloc of+ Alloc.Delayed -> case node of+ NValue _ _ -> False+ _ -> True+ _ -> True+ + suffix i = if isManifest then "[" ++ shiftStr i ++ "]" + else foldMap cppoku (cursorToShift cur)+ cppoku = (("_"++).(map (\c->if c=='-' then 'm' else c)).symbol Cpp)+ + shiftStr i = if shift == Additive.zero + then nameStr i+ else fst (mapAccumR shiftAccum "" allAxes)+ allAxes = fmap fst axes3+ idxAxes = fmap (fst.snd) axes3+ shift = fmap (snd.snd) axes3+ + shiftedAxis ax = paren$+ (paren $ unwords [idxAxes ! ax, "+", symbol Cpp (shift ! ax),"+",sizeForAxisCall ax])+ ++ "%" ++ sizeForAxisCall ax+ + shiftAccum str ax = + if (axisIndex ax::Int) == dimension allAxes - 1+ then (shiftedAxis ax, ())+ else (unwords [shiftedAxis ax, "+", sizeForAxisCall ax , "*", paren str], ())+ +leftHandSide :: (Vector v, Symbolable Cpp g, Additive.C (v g), Ord (v g)) =>+ Cursor v g -> Binder v g String+leftHandSide = cursorToSymbol LeftHand++rightHandSide :: (Vector v, Symbolable Cpp g, Additive.C (v g), Ord (v g)) =>+ Cursor v g -> Binder v g String+rightHandSide cur = do+ node0 <- cursorToNode cur+ case node0 of+ NInst inst _ -> rhsInst inst cur+ NValue _ _ -> do + when (allocStrategy (getA node0) == Alloc.Delayed) $ addBinding cur + cursorToSymbol RightHand cur+++rhsInst :: (Vector v, Symbolable Cpp g, Additive.C (v g), Ord (v g)) =>+ Inst v g -> Cursor v g -> Binder v g String+rhsInst inst cursor = do+ graph <- bindersGraph+ let + curNode = cursorToFGLNode cursor+ -- FGL indices of all the preceding nodes.+ preNodes = map snd $ List.sort $ + map (\(node, l) -> (l,node)) $ + FGL.lpre graph(curNode)+ -- Cursors of all the preceding nodes with context inherited from cursor.+ preCursors = map (\n -> cursor{cursorToFGLNode = n}) preNodes+ headCursor = head preCursors+ headNode = cursorToFGLNode headCursor+ case inst of+ Imm dyn0 -> return $ symbol Cpp dyn0+ Load _ -> cursorToSymbol RightHand cursor+ Store _ -> error "Store has no RHS!"+ Reduce op -> reduceBinder op curNode headNode+ Broadcast -> cursorToSymbol RightHand (CurGlobal $ head preNodes)+{- + Shift vec -> cursorToSymbol RightHand headCursor+ {cursorToShift = vec + cursorToShift headCursor}+-}+ Shift vec -> rightHandSide headCursor{cursorToShift = vec + cursorToShift headCursor}+ LoadIndex a -> rhsLoadIndex a+ Arith op -> do+ xs <- mapM rightHandSide preCursors+ return $ arithRep op xs++rhsLoadIndex :: (Vector v, Symbolable Cpp g, Additive.C (v g), Ord (v g)) =>+ Axis v -> Binder v g String+rhsLoadIndex axis = do+ ctx <- bindersContext+ let+ loopVar = case ctx of+ CtxGlobal -> error "cannot load index in gloabl context"+ CtxLocal i -> nameStr i+ axesSmaller = List.filter (\ax -> axisIndex ax < axisIndex axis) (allAxes axis)+ divs = paren $ unwords $ List.intersperse "/" $ loopVar : map sizeForAxisCall axesSmaller+ ret = paren $ unwords $ [divs , "%" ,sizeForAxisCall axis]+ allAxes axis1 = foldMap (:[]) $ compose (\axis' -> head [axis', axis1])++ return ret++{---- -----}+{---- c++ kernel generation -----}+{---- -----}+++genCpp :: (Vector v, Ring.C g, Additive.C (v g), Ord (v g), Symbolable Cpp g) =>+ String -> [CMember] -> POM v g (Strategy Cpp) -> String+genCpp headerFn _ pom = unlines [+ "#include \"" ++ headerFn ++ "\"",+ "using namespace std;",+ "",+ kernelsStr+ ]+ where+ classPrefix = nameStr pom ++ "::"+ kernelsStr = unlines $ map (declareKernel classPrefix) $+ kernels pom+++declareKernel :: (Vector v, Ring.C g, Additive.C (v g), Ord (v g), Symbolable Cpp g) => + String -> Kernel v g (Strategy Cpp)-> String+declareKernel classPrefix kern = unlines [+ "void " ++ classPrefix ++ nameStr kern ++ " () {",+ declareNodes labNodes,+ substituteNodes labNodes,+ "return;",+ "}"+ ]+ where+ graph = dataflow kern+ labNodes = FGL.labNodes graph++ declareNodes = unlines . concat . map declareNode+ declareNode (n, node) = case node of+ NInst _ _ -> []+ NValue _ (CppStrategy Alloc.Delayed) -> []+ NValue dyn0 _ -> [declareVal (nameStr $ fglNodeName n) dyn0]+ declareVal name0 dyn0 = let+ x = if DVal.realm dyn0 == Local + then "(" ++ symbol Cpp sizeName ++ "())"+ else ""+ in symbol Cpp dyn0 ++ " " ++ name0 ++ x ++ ";"+ substituteNodes = unlines. concat . map substituteNode+ substituteNode (n, node) = case allocStrategy $ getA node of+ Alloc.Manifest -> [genSub n]+ _ -> []+ genSub n = + runBinder graph n addBinding++ +
+ Language/Paraiso/Interval.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE StandaloneDeriving #-}+{- | an 'Interval' is a pair of 'lower' and 'upper', + representing some interval in ordered system.+ The lower bound is inclusive and the upper bound is exclusive:+ ('lower' <= x < 'upper') .+ The intersection of two intervals are also interval + but the union of two intervals are not, + so 'Interval' constitute a 'PiSystem'.+ -}++module Language.Paraiso.Interval (+ Interval(..)) where+++import Language.Paraiso.PiSystem as S+import Prelude hiding (null)++data Interval a = + -- | an empty interval.+ Empty | + -- | a non-empty interval.+ Interval{lower::a, upper::a}++instance (Ord a) => PiSystem (Interval a) where+ empty = Empty+ null Empty = True+ null (Interval l u) = l >= u+ intersection Empty _ = Empty+ intersection _ Empty = Empty+ intersection (Interval l1 u1) (Interval l2 u2) =+ let l = max l1 l2; u = min u1 u2; ret = Interval l u in+ if null ret then Empty else ret++deriving instance (Eq a) => Eq (Interval a) +deriving instance (Show a) => Show (Interval a) +deriving instance (Read a) => Read (Interval a)++++
+ Language/Paraiso/Name.hs view
@@ -0,0 +1,43 @@+{-# Language StandaloneDeriving #-}+{-# OPTIONS -Wall #-}++-- | name identifier.+module Language.Paraiso.Name + (+ Name(..), Named(..),+ Nameable(..), namee+ ) where+import Control.Monad++-- | a name.+newtype Name = Name String deriving (Eq, Ord, Show, Read)++-- | something that has name.+class Nameable a where+ -- | get its name.+ name :: a -> Name+ -- | get its name as a 'String'.+ nameStr :: a -> String+ nameStr = (\(Name str) -> str) . name++-- | 'Name' has 'Name'. 'Name' of 'Name' is 'Name' itself. +instance Nameable Name where+ name = id++-- | Convert some type to a named type.+data Named a = Named Name a++instance Nameable (Named a) where+ name (Named n _) = n+instance Functor Named where+ fmap f (Named n a) = Named n $ f a+++-- | The thing the name points to.+namee :: Named a -> a+namee (Named _ x) = x++deriving instance (Eq a) => Eq (Named a)+deriving instance (Ord a) => Ord (Named a)+deriving instance (Show a) => Show (Named a)+deriving instance (Read a) => Read (Named a)
+ Language/Paraiso/OM/Arithmetic.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS -Wall #-}+module Language.Paraiso.OM.Arithmetic + (+ Arity(..), arityI, arityO,+ Operator(..)+ ) where++import NumericPrelude hiding (Ordering(..), Eq(..), Ord(..))+import qualified NumericPrelude as P++class Arity a where+ arity :: a -> (Int, Int)++arityI, arityO :: (Arity a) => a -> Int+arityI = fst.arity+arityO = snd.arity+ +data Operator = + Add |+ Sub |+ Neg |+ Mul | + Div |+ Inv |+ Not |+ And |+ Or |+ EQ |+ NE |+ LT |+ LE |+ GT |+ GE |+ Max |+ Min |+ Abs |+ Signum |+ Select |+ -- | x^y where y is an integer+ Ipow |+ -- | x^y where y is real number+ Pow |+ Madd |+ Msub |+ Nmadd |+ Nmsub |+ Sqrt |+ Exp |+ Log |+ Sin |+ Cos |+ Tan |+ Asin |+ Acos |+ Atan |+ Sincos + deriving (P.Eq, P.Ord, P.Show, P.Read)++instance Arity Operator where+ arity a = case a of+ Add -> (2,1)+ Sub -> (2,1)+ Neg -> (1,1)+ Mul -> (2,1)+ Div -> (2,1)+ Inv -> (1,1)+ Not -> (1,1)+ And -> (2,1)+ Or -> (2,1)+ EQ -> (2,1)+ NE -> (2,1)+ LT -> (2,1)+ LE -> (2,1)+ GT -> (2,1)+ GE -> (2,1)+ Max -> (2,1)+ Min -> (2,1)+ Abs -> (1,1)+ Signum -> (1,1)+ Select -> (3,1)+ Ipow -> (2,1)+ Pow -> (2,1)+ Madd -> (3,1)+ Msub -> (3,1)+ Nmadd -> (3,1)+ Nmsub -> (3,1)+ Sqrt -> (1,1)+ Exp -> (1,1)+ Log -> (1,1)+ Sin -> (1,1)+ Cos -> (1,1)+ Tan -> (1,1)+ Asin -> (1,1)+ Acos -> (1,1)+ Atan -> (1,1)+ Sincos -> (1,2)+
+ Language/Paraiso/OM/Builder.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleInstances, NoImplicitPrelude, RankNTypes, TypeSynonymInstances #-}+{-# OPTIONS -Wall #-}++-- | A monadic library to build dataflow graphs for OM. +-- This module just exports a set of chosen symbols+-- from 'Language.Paraiso.OM.Builder.Internal'.++module Language.Paraiso.OM.Builder+ (+ Builder, BuilderState(..),+ BuilderOf,+ makeKernel,+ load, store, imm,+ reduce, broadcast, shift, loadIndex+ ) where++import Language.Paraiso.OM.Builder.Internal
+ Language/Paraiso/OM/Builder/Boolean.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleInstances, NoImplicitPrelude, TypeSynonymInstances #-}+{-# OPTIONS -Wall #-}+-- | An extension module of building blocks. Contains booleans, comparison operations, branchings.++module Language.Paraiso.OM.Builder.Boolean+ (eq, ne, lt, le, gt, ge, select) where++import qualified Algebra.Ring as Ring+import Data.Dynamic (Typeable, typeOf)+import qualified Language.Paraiso.OM.Arithmetic as A+import Language.Paraiso.OM.Builder.Internal+import Language.Paraiso.OM.DynValue as DVal+import Language.Paraiso.OM.Graph+import Language.Paraiso.OM.Realm as Realm+import Language.Paraiso.OM.Value as Val+import Language.Paraiso.Tensor+import NumericPrelude +++-- | generate a binary operator that returns Bool results.+mkOp2B :: (Vector v, Ring.C g, TRealm r, Typeable c) => + A.Operator -- ^The operation to be performed+ -> (Builder v g (Value r c)) -- ^The first argument+ -> (Builder v g (Value r c)) -- ^The second argument+ -> (Builder v g (Value r Bool)) -- ^The result+mkOp2B op builder1 builder2 = do+ v1 <- builder1+ v2 <- builder2+ let + r1 = Val.realm v1+ n1 <- valueToNode v1+ n2 <- valueToNode v2+ n0 <- addNode [n1, n2] (NInst (Arith op) ())+ n01 <- addNode [n0] (NValue (toDyn v1){typeRep = typeOf True} ())+ return $ FromNode r1 True n01+++eq, ne, lt, le, gt, ge :: (Vector v, Ring.C g, TRealm r, Typeable c) => + (Builder v g (Value r c)) -> (Builder v g (Value r c)) -> (Builder v g (Value r Bool))++-- | Equal+eq = mkOp2B A.EQ+-- | Not equal+ne = mkOp2B A.NE+-- | Less than+lt = mkOp2B A.LT+-- | Less than or equal to+le = mkOp2B A.LE+-- | Greater than+gt = mkOp2B A.GT+-- | Greater than or equal to+ge = mkOp2B A.GE++-- | selects either the second or the third argument based +select ::(Vector v, Ring.C g, TRealm r, Typeable c) => + (Builder v g (Value r Bool)) -- ^The 'Bool' condition+ -> (Builder v g (Value r c)) -- ^The value chosen when the condition is 'True'+ -> (Builder v g (Value r c)) -- ^The value chosen when the condition is 'False'+ -> (Builder v g (Value r c)) -- ^The result+select builderB builder1 builder2 = do+ vb <- builderB+ v1 <- builder1+ v2 <- builder2+ nb <- valueToNode vb+ n1 <- valueToNode v1+ n2 <- valueToNode v2+ n0 <- addNode [nb, n1, n2] (NInst (Arith A.Select) ())+ n01 <- addNode [n0] (NValue (toDyn v1) ())+ let + r1 = Val.realm v1+ c1 = Val.content v1+ return $ FromNode r1 c1 n01+
+ Language/Paraiso/OM/Builder/Internal.hs view
@@ -0,0 +1,343 @@+{-# LANGUAGE FlexibleInstances, NoImplicitPrelude, + RankNTypes, TypeSynonymInstances #-}+{-# OPTIONS -Wall #-}++-- | A monadic library to build dataflow graphs for OM. +-- Builder is only for Graph vector gauge () . +-- Graphs with other annotation types can be created by fmap.+-- This module exports everything, for writing other Builder modules.++module Language.Paraiso.OM.Builder.Internal+ (+ Builder, BuilderState(..),+ B, BuilderOf,+ makeKernel, initState,+ modifyG, getG, freeNode, addNode, valueToNode, lookUpStatic,+ load, store,+ reduce, broadcast,+ shift, loadIndex,+ imm, mkOp1, mkOp2+ ) where+import qualified Algebra.Absolute as Absolute+import qualified Algebra.Additive as Additive+import qualified Algebra.Algebraic as Algebraic+import qualified Algebra.Field as Field+import qualified Algebra.Lattice as Lattice+import qualified Algebra.Ring as Ring+import qualified Algebra.Transcendental as Transcendental+import qualified Algebra.ZeroTestable as ZeroTestable+import Control.Monad+import qualified Control.Monad.State as State+import qualified Data.Graph.Inductive as FGL+import Data.Dynamic (Typeable)+import qualified Data.Dynamic as Dynamic+import qualified Language.Paraiso.OM.Arithmetic as A+import Language.Paraiso.OM.DynValue as DVal+import Language.Paraiso.OM.Graph+import Language.Paraiso.OM.Realm as Realm+import Language.Paraiso.OM.Reduce as Reduce+import Language.Paraiso.OM.Value as Val+import Language.Paraiso.Prelude+import Language.Paraiso.Tensor+import qualified Prelude (Num(..), Fractional(..))++data BuilderState vector gauge = BuilderState + { setup :: Setup vector gauge, + target :: Graph vector gauge ()} deriving (Show)++-- | Create a 'Kernel' from a 'Builder' monad.+makeKernel :: (Vector v, Ring.C g) => + Setup v g -- ^The Orthotope machine setup.+ -> Name -- ^The name of the kernel.+ -> Builder v g () -- ^The builder monad.+ -> Kernel v g () -- ^The created kernel.+makeKernel setup0 name0 builder0 = let+ state0 = initState setup0+ graph = target $ snd $ State.runState builder0 state0+ in Kernel{kernelName = name0, dataflow = graph}+ ++-- | Create an initial state for 'Builder' monad from a OM 'Setup'.+initState :: Setup v g -> BuilderState v g+initState s = BuilderState {+ setup = s,+ target = FGL.empty+ }++-- | The 'Builder' monad is used to build 'Kernel's.+type Builder vector gauge val = + State.State (BuilderState vector gauge) val+ +-- 'Builder' needs to be an instance of 'Eq' to become an instance of 'Prelude.Num' +instance Eq (Builder v g v2) where+ _ == _ = undefined+-- 'Builder' needs to be an instance of 'Show' to become an instance of 'Prelude.Num' +instance Show (Builder v g v2) where+ show _ = "<<REDACTED>>"++type B a = (Vector v, Ring.C g) => Builder v g a+type BuilderOf r c = (Vector v, Ring.C g) => Builder v g (Value r c)++-- | Modify the dataflow graph stored in the 'Builder'.+modifyG :: (Vector v, Ring.C g) => + (Graph v g () -> Graph v g ()) -- ^The graph modifying function.+ -> Builder v g () -- ^The state gets silently modified.+modifyG f = State.modify (\bs -> bs{target = f.target $ bs})++-- | Get the graph stored in the 'Builder'.+getG :: (Vector v, Ring.C g) => Builder v g (Graph v g ())+getG = fmap target State.get++-- | get the number of the next unoccupied 'FGL.Node' in the graph.+freeNode :: B FGL.Node+freeNode = do+ n <- fmap (FGL.noNodes) getG+ return n+ +-- | add a node to the graph.+addNode :: (Vector v, Ring.C g) => + [FGL.Node] -- ^The list of dependent nodes. The order is recorded.+ -> Node v g () -- ^The new node to be added+ -> Builder v g FGL.Node+addNode froms new = do+ n <- freeNode+ modifyG (([(EOrd i, froms !! i) | i <-[0..length froms - 1] ], n, new, []) FGL.&)+ return n+++-- | convert a 'Value' to a +valueToNode :: (TRealm r, Typeable c) => Value r c -> B FGL.Node+valueToNode val = do+ let + con = Val.content val+ type0 = toDyn val+ case val of+ FromNode _ _ n -> return n+ FromImm _ _ -> do+ n0 <- addNode [] (NInst (Imm (Dynamic.toDyn con)) ())+ n1 <- addNode [n0] (NValue type0 ())+ return n1++-- | look up the 'Named' 'DynValue' with the correct name and type +-- is included in the 'staticValues' of the 'BuilderState'+lookUpStatic :: Named DynValue -> B ()+lookUpStatic (Named name0 type0)= do+ st <- State.get + let+ vs :: [Named DynValue]+ vs = staticValues $ setup st+ matches = filter ((==name0).name) vs+ (Named _ type1) = head matches+ when (length matches == 0) $ fail ("no name found: " ++ nameStr name0)+ when (length matches > 1) $ fail ("multiple match found:" ++ nameStr name0)+ when (type0 /= type1) $ fail ("type mismatch; expected: " ++ show type1 ++ "; " +++ " actual: " ++ nameStr name0 ++ "::" ++ show type0)++-- | Load from a static value.+load :: (TRealm r, Typeable c) => + r -- ^The 'TRealm' type.+ -> c -- ^The 'Val.content' type.+ -> Name -- ^The 'Name' of the static value to load.+ -> B (Value r c) -- ^The loaded 'TLocal' 'Value' as a result.+load r0 c0 name0 = do+ let + type0 = mkDyn r0 c0+ nv = Named name0 type0+ lookUpStatic nv+ n0 <- addNode [] (NInst (Load name0) ())+ n1 <- addNode [n0] (NValue type0 ())+ return (FromNode r0 c0 n1)++-- | Store to a static value.+store :: (Vector v, Ring.C g, TRealm r, Typeable c) => + Name -- ^The 'Name' of the static value to store.+ -> Builder v g (Value r c) -- ^The 'Value' to be stored.+ -> Builder v g () -- ^The result.+store name0 builder0 = do+ val0 <- builder0+ let + type0 = toDyn val0+ nv = Named name0 type0+ lookUpStatic nv+ n0 <- valueToNode val0+ _ <- addNode [n0] (NInst (Store name0) ())+ return ()+++-- | Reduce over a 'TLocal' 'Value' +-- using the specified reduction 'Reduce.Operator'+-- to make a 'TGlobal' 'Value'+reduce :: (Vector v, Ring.C g, Typeable c) => + Reduce.Operator -- ^The reduction 'Reduce.Operator'.+ -> Builder v g (Value TLocal c) -- ^The 'TLocal' 'Value' to be reduced.+ -> Builder v g (Value TGlobal c) -- ^The 'TGlobal' 'Value' that holds the reduction result.+reduce op builder1 = do + val1 <- builder1+ let + c1 = Val.content val1+ type2 = mkDyn TGlobal c1+ n1 <- valueToNode val1+ n2 <- addNode [n1] (NInst (Reduce op) ())+ n3 <- addNode [n2] (NValue type2 ())+ return (FromNode TGlobal c1 n3)++-- | Broadcast a 'TGlobal' 'Value' +-- to make it a 'TLocal' 'Value' +broadcast :: (Vector v, Ring.C g, Typeable c) => + Builder v g (Value TGlobal c) -- ^The 'TGlobal' 'Value' to be broadcasted.+ -> Builder v g (Value TLocal c) -- ^The 'TLocal' 'Value', all of them containing the global value.+broadcast builder1 = do + val1 <- builder1+ let + c1 = Val.content val1+ type2 = mkDyn TLocal c1+ n1 <- valueToNode val1+ n2 <- addNode [n1] (NInst Broadcast ())+ n3 <- addNode [n2] (NValue type2 ())+ return (FromNode TLocal c1 n3)+ +-- | Shift a 'TLocal' 'Value' with a constant vector.+shift :: (Vector v, Ring.C g, Typeable c, Additive.C (v g)) => + v g -- ^ The amount of shift + -> Builder v g (Value TLocal c) -- ^ The 'TLocal' Value to be shifted+ -> Builder v g (Value TLocal c) -- ^ The shifted 'TLocal' 'Value' as a result.+shift vec builder1 = do+ val1 <- builder1+ let + type1 = toDyn val1+ c1 = Val.content val1+ n1 <- valueToNode val1+ n2 <- addNode [n1] (NInst (Shift (Additive.negate vec)) ())+ n3 <- addNode [n2] (NValue type1 ())+ return (FromNode TLocal c1 n3)++-- | Load the 'Axis' component of the mesh address, to a 'TLocal' 'Value'.+loadIndex :: (Vector v, Ring.C g, Typeable c) => + c -- ^The 'Val.content' type.+ -> Axis v -- ^ The axis for which index is required+ -> Builder v g (Value TLocal c) -- ^ The 'TLocal' 'Value' that contains the address as a result.+loadIndex c0 axis = do+ let type0 = mkDyn TLocal c0+ n0 <- addNode [] (NInst (LoadIndex axis) ())+ n1 <- addNode [n0] (NValue type0 ())+ return (FromNode TLocal c0 n1)+++-- | Create an immediate 'Value' from a Haskell concrete value. +-- 'TRealm' is type-inferred.+imm :: (TRealm r, Typeable c) => + c -- ^A Haskell value of type @c@ to be stored.+ -> B (Value r c) -- ^'TLocal' 'Value' with the @c@ stored.+imm c0 = return (FromImm unitTRealm c0)++-- | Make a unary operator+mkOp1 :: (Vector v, Ring.C g, TRealm r, Typeable c) => + A.Operator -- ^The operator symbol+ -> (Builder v g (Value r c)) -- ^Input+ -> (Builder v g (Value r c)) -- ^Output +mkOp1 op builder1 = do+ v1 <- builder1+ let + r1 = Val.realm v1+ c1 = Val.content v1+ n1 <- valueToNode v1+ n0 <- addNode [n1] (NInst (Arith op) ())+ n01 <- addNode [n0] (NValue (toDyn v1) ())+ return $ FromNode r1 c1 n01++-- | Make a binary operator+mkOp2 :: (Vector v, Ring.C g, TRealm r, Typeable c) => + A.Operator -- ^The operator symbol + -> (Builder v g (Value r c)) -- ^Input 1 + -> (Builder v g (Value r c)) -- ^Input 2 + -> (Builder v g (Value r c)) -- ^Output +mkOp2 op builder1 builder2 = do+ v1 <- builder1+ v2 <- builder2+ let + r1 = Val.realm v1+ c1 = Val.content v1+ n1 <- valueToNode v1+ n2 <- valueToNode v2+ n0 <- addNode [n1, n2] (NInst (Arith op) ())+ n01 <- addNode [n0] (NValue (toDyn v1) ())+ return $ FromNode r1 c1 n01+++-- | Builder is Additive 'Additive.C'.+-- You can use 'Additive.zero', 'Additive.+', 'Additive.-', 'Additive.negate'.+instance (Vector v, Ring.C g, TRealm r, Typeable c, Additive.C c) => Additive.C (Builder v g (Value r c)) where+ zero = return $ FromImm unitTRealm Additive.zero+ (+) = mkOp2 A.Add+ (-) = mkOp2 A.Sub+ negate = mkOp1 A.Neg+ +-- | Builder is Ring 'Ring.C'.+-- You can use 'Ring.one', 'Ring.*'.+instance (Vector v, Ring.C g, TRealm r, Typeable c, Ring.C c) => Ring.C (Builder v g (Value r c)) where+ one = return $ FromImm unitTRealm Ring.one+ (*) = mkOp2 A.Mul+ fromInteger = imm . fromInteger+ +-- | you can convert GHC numeric immediates to 'Builder'.+instance (Vector v, Ring.C g, TRealm r, Typeable c, Ring.C c) => Prelude.Num (Builder v g (Value r c)) where + (+) = (Additive.+)+ (*) = (Ring.*)+ (-) = (Additive.-)+ negate = Additive.negate+ abs = undefined+ signum = undefined+ fromInteger = Ring.fromInteger+ +-- | Builder is Field 'Field.C'. You can use 'Field./', 'Field.recip'.+instance (Vector v, Ring.C g, TRealm r, Typeable c, Field.C c) => Field.C (Builder v g (Value r c)) where+ (/) = mkOp2 A.Div+ recip = mkOp1 A.Inv+ fromRational' = imm . fromRational'++-- | you can convert GHC floating point immediates to 'Builder'.+instance (Vector v, Ring.C g, TRealm r, Typeable c, Field.C c, Prelude.Fractional c) => Prelude.Fractional (Builder v g (Value r c)) where + (/) = (Field./)+ recip = Field.recip+ fromRational = imm . Prelude.fromRational++-- | Builder is 'Boolean'. You can use 'true', 'false', 'not', '&&', '||'.+instance (Vector v, Ring.C g, TRealm r) => Boolean (Builder v g (Value r Bool)) where + true = imm True+ false = imm False+ not = mkOp1 A.Not+ (&&) = mkOp2 A.And+ (||) = mkOp2 A.Or++-- | Builder is Algebraic 'Algebraic.C'. You can use 'Algebraic.sqrt' and so on.+instance (Vector v, Ring.C g, TRealm r, Typeable c, Algebraic.C c) => Algebraic.C (Builder v g (Value r c)) where+ sqrt = mkOp1 A.Sqrt+ x ^/ y = mkOp2 A.Pow x (fromRational' y)++-- | choose the larger or the smaller of the two.+instance (Vector v, Ring.C g, TRealm r, Typeable c) => Lattice.C (Builder v g (Value r c))+ where+ up = mkOp2 A.Max + dn = mkOp2 A.Min++instance (Vector v, Ring.C g, TRealm r, Typeable c) => ZeroTestable.C (Builder v g (Value r c))+ where+ isZero _ = error "isZero undefined for builder."+ +instance (Vector v, Ring.C g, TRealm r, Typeable c, Ring.C c) => Absolute.C (Builder v g (Value r c))+ where+ abs = mkOp1 A.Abs+ signum = mkOp1 A.Signum++instance (Vector v, Ring.C g, TRealm r, Typeable c, Transcendental.C c) => + Transcendental.C (Builder v g (Value r c)) where + pi = imm pi+ exp = mkOp1 A.Exp+ log = mkOp1 A.Log+ sin = mkOp1 A.Sin+ cos = mkOp1 A.Cos+ tan = mkOp1 A.Tan+ asin = mkOp1 A.Asin+ acos = mkOp1 A.Acos+ atan = mkOp1 A.Atan+
+ Language/Paraiso/OM/DynValue.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS -Wall #-}++-- | The 'Value' is flowing through the OM dataflow graph.+-- 'Value' carries the type and homogeneity information about the dataflow.++module Language.Paraiso.OM.DynValue+ (+ DynValue(..), mkDyn, toDyn+ ) where++import Data.Typeable+import qualified Language.Paraiso.OM.Value as Val+import qualified Language.Paraiso.OM.Realm as R++-- | dynamic value type, with its realm and content type informed as values+data DynValue = DynValue {realm :: R.Realm, typeRep :: TypeRep} deriving (Eq, Show)++-- | Make 'DynValue' value-level type, from the pair of Type-level type.+mkDyn :: (R.TRealm r, Typeable c) => r -> c -> DynValue+mkDyn r0 c0 = DynValue (R.tRealm r0) (typeOf c0)++-- | Convert 'Val.Value' to 'DynValue'+toDyn :: (R.TRealm r, Typeable c) => Val.Value r c -> DynValue+toDyn x = mkDyn (Val.realm x) (Val.content x)++instance R.Realmable DynValue where+ realm = realm
+ Language/Paraiso/OM/Graph.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude, + StandaloneDeriving #-}+{-# OPTIONS -Wall #-}++-- | all the components for constructing Orthotope Machine data flow draph.+module Language.Paraiso.OM.Graph+ (+ Setup(..), Kernel(..), Graph, nmap, getA,+ Annotation(..),+ Node(..), Edge(..),+ Inst(..),+ module Language.Paraiso.Name+ )where++import qualified Algebra.Ring as Ring+import Data.Dynamic+import qualified Data.Graph.Inductive as FGL+import Language.Paraiso.Name+import Language.Paraiso.OM.Arithmetic as A+import Language.Paraiso.OM.Reduce as R+import Language.Paraiso.OM.DynValue+import Language.Paraiso.Tensor+import NumericPrelude+++-- | An OM Setup, a set of information needed before you start building a 'Kernel'.+-- It's basically a list of static orthotopes +-- (its identifier, Realm and Type carried in the form of 'NamedValue')+data (Vector vector, Ring.C gauge) => Setup vector gauge = + Setup {+ staticValues :: [Named DynValue]+ } deriving (Eq, Show)++-- | A 'Kernel' for OM does a bunch of calculations on OM.+data (Vector vector, Ring.C gauge) => Kernel vector gauge a = + Kernel {+ kernelName :: Name,+ dataflow :: Graph vector gauge a+ } + deriving (Show)++instance (Vector v, Ring.C g) => Nameable (Kernel v g a) where+ name = kernelName+++-- | The dataflow graph for Orthotope Machine. a is an additional annotation.+type Graph vector gauge a = FGL.Gr (Node vector gauge a) Edge++-- | Map the 'Graph' annotation from one type to another. Unfortunately we cannot make one data+-- both the instances of 'FGL.Graph' and 'Functor', so 'nmap' is a standalone function.+nmap :: (Vector v, Ring.C g) => (a -> b) -> Graph v g a -> Graph v g b+nmap f = let+ nmap' f0 (NValue x a0) = (NValue x $ f0 a0) + nmap' f0 (NInst x a0) = (NInst x $ f0 a0) + in FGL.nmap (nmap' f)+++-- | The 'Node' for the dataflow 'Graph' of the Orthotope machine.+-- The dataflow graph is a 2-part graph consisting of 'NValue' and 'NInst' nodes.+data Node vector gauge a = + -- | A value node. An 'NValue' node only connects to 'NInst' nodes.+ -- An 'NValue' node has one and only one input edge, and has arbitrary number of output edges.+ NValue DynValue a |+ -- | An instruction node. An 'NInst' node only connects to 'NValue' nodes.+ -- The number of input and output edges an 'NValue' node has is specified by its 'Arity'.+ NInst (Inst vector gauge) a+ deriving (Show)++-- | The 'Edge' label for the dataflow 'Graph'. +-- | It keeps track of the order of the arguments.+data Edge = + -- | an unordered edge. + EUnord | + -- | edges where the order matters.+ EOrd Int deriving (Eq, Ord, Show)++-- | get annotation of the node.+getA :: Node v g a -> a+getA nd = case nd of+ NValue _ x -> x+ NInst _ x -> x+ +++instance (Vector v, Ring.C g) => Functor (Node v g) where+ fmap f (NValue x y) = (NValue x (f y)) + fmap f (NInst x y) = (NInst x (f y)) ++data Inst vector gauge = + Imm Dynamic |+ Load Name |+ Store Name |+ Reduce R.Operator |+ Broadcast |+ Shift (vector gauge) |+ LoadIndex (Axis vector) |+ Arith A.Operator + deriving (Show)++instance Arity (Inst vector gauge) where+ arity a = case a of+ Imm _ -> (0,1)+ Load _ -> (0,1)+ Store _ -> (1,0)+ Reduce _ -> (1,1)+ Broadcast -> (1,1)+ Shift _ -> (1,1)+ LoadIndex _ -> (0,1)+ Arith op -> arity op+++-- | you can insert 'Annotation's to control the code generation processes.+data Annotation = Comment String | Balloon+ deriving (Eq, Ord, Read, Show)+
+ Language/Paraiso/OM/Realm.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+{-# OPTIONS -Wall #-}++-- | The 'Realm' represents how the data reside in Orthotope Machines. +-- 'Local' data are n-dimensional array that is distributed among nodes.+-- 'Global' data are single-point value, possibly reside in the master node.++module Language.Paraiso.OM.Realm+ (+ TGlobal(..), TLocal(..), TRealm(..),+ Realm(..), Realmable(..),+ ) where++-- | Type-level representations+class TRealm a where+ tRealm :: a -> Realm+ unitTRealm :: a+ +data TGlobal = TGlobal+data TLocal = TLocal+instance TRealm TGlobal where+ tRealm _ = Global + unitTRealm = TGlobal+instance TRealm TLocal where+ tRealm _ = Local+ unitTRealm = TLocal++-- | Value-level representations+data Realm = Global | Local deriving (Eq, Show)++-- | Means of obtaining value-level realm from things+class Realmable a where+ realm :: a -> Realm+ +-- | Realmable instances +instance Realmable Realm where+ realm = id +instance TRealm a => Realmable a where+ realm = tRealm
+ Language/Paraiso/OM/Reduce.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS -Wall #-}+module Language.Paraiso.OM.Reduce + (Operator(..),+ toArith+ ) where++import qualified Language.Paraiso.OM.Arithmetic as A++data Operator = Max | Min | Sum deriving (Eq, Ord, Show, Read)+++toArith :: Operator -> A.Operator+toArith op = case op of+ Max -> A.Max+ Min -> A.Min+ Sum -> A.Add
+ Language/Paraiso/OM/Value.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS -Wall #-}++-- | The 'Value' is flowing through the OM dataflow graph.+-- 'Value' carries the type and homogeneity information about the dataflow.++module Language.Paraiso.OM.Value+ (+ Value(..)+ ) where++import Data.Typeable+import qualified Data.Graph.Inductive as G+import qualified Language.Paraiso.OM.Realm as R+++-- | value type, with its realm and content type discriminated in type level+data (R.TRealm rea, Typeable con) => + Value rea con = + -- | data obtained from the dataflow graph.+ -- 'realm' carries a type-level realm information, + -- 'content' carries only type information and its ingredient is nonsignificant+ -- and can be 'undefined'.+ FromNode {realm :: rea, content :: con, node :: G.Node} | + -- | data obtained as an immediate value.+ -- 'realm' carries a type-level realm information, + -- 'content' is the immediate value to be stored.+ FromImm {realm :: rea, content :: con} deriving (Eq, Show)+ ++instance (R.TRealm rea, Typeable con) => R.Realmable (Value rea con) where+ realm (FromNode r _ _) = R.realm r+ realm (FromImm r _) = R.realm r+ ++
+ Language/Paraiso/Orthotope.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TypeOperators #-}++{- | In geometry, an 'Orthotope' (also called a hyperrectangle or a box) is+ the generalization of a rectangle for higher dimensions, formally+ defined as the Cartesian product of 'Interval's.++-}++module Language.Paraiso.Orthotope(+ Orthotope0,+ Orthotope1,Orthotope2,Orthotope3+) where++import Language.Paraiso.Tensor+import Language.Paraiso.Interval++++type Orthotope0 a = Vec0 (Interval a)+type Orthotope1 a = Vec1 (Interval a)+type Orthotope2 a = Vec2 (Interval a)+type Orthotope3 a = Vec3 (Interval a)+
+ Language/Paraiso/POM.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS -Wall #-}+module Language.Paraiso.POM+ (+ POM(..), makePOM, mapGraph+ ) where++import qualified Algebra.Ring as Ring+import qualified Control.Monad as Monad+import Language.Paraiso.OM.Builder (Builder, makeKernel)+import Language.Paraiso.OM.Graph+import Language.Paraiso.Tensor+import NumericPrelude++-- | POM is Primordial Orthotope Machine.+data (Vector vector, Ring.C gauge) => POM vector gauge a = + POM {+ pomName :: Name,+ setup :: Setup vector gauge,+ kernels :: [Kernel vector gauge a]+ } + deriving (Show)++instance (Vector v, Ring.C g) => Nameable (POM v g a) where+ name = pomName++instance (Vector v, Ring.C g) => Monad.Functor (POM v g) where+ fmap = mapGraph . nmap ++-- | modify each of the graphs in POM.+mapGraph :: (Vector v, Ring.C g) => + (Graph v g a -> Graph v g b)+ -> POM v g a + -> POM v g b+mapGraph f pom = pom+ { kernels = map + (\kern -> kern{dataflow = f $ dataflow kern}) $ + kernels pom}+++-- | create a POM easily and consistently.+makePOM :: (Vector v, Ring.C g) => + Name -- ^The machine name.+ -> (Setup v g) -- ^The machine configuration.+ -> [(Name, Builder v g ())] -- ^The list of pair of the kernel name and its builder.+ -> POM v g () -- ^The result.+makePOM name0 setup0 kerns = + POM {+ pomName = name0,+ setup = setup0,+ kernels = map (\(n,b) -> makeKernel setup0 n b) kerns+ }+ ++++
+ Language/Paraiso/PiSystem.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TypeOperators, FlexibleInstances, OverlappingInstances #-}++{- | In mathematics, a pi-system is a non-empty family of sets that is closed+under finite intersections. -}+module Language.Paraiso.PiSystem (PiSystem(..)) where++import Prelude hiding (null)+import qualified Data.Foldable as F+import Language.Paraiso.Tensor++class PiSystem a where+ -- | an empty set.+ empty :: a+ -- | is this an empty set?+ null :: a -> Bool+ -- | intersection of two sets.+ intersection :: a -> a -> a+ +{- | a 'Vector' of 'PiSystem' is also a 'PiSystem'. + This is an overlapping instance, + can be overwritten by more specific instances.+-}+instance (PiSystem a, Vector v) => PiSystem (v a) where+ empty = compose $ const empty+ null = F.any null+ intersection a b = compose (\i -> component i a `intersection` component i b)+
+ Language/Paraiso/Prelude.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS -Wall #-}+{- |+ Redefine some items from the standard Prelude.+-}++++module Language.Paraiso.Prelude+ (+ module Control.Applicative,+ module Control.Monad,+ module Data.Foldable,+ module Data.Traversable,+ module NumericPrelude,+ Boolean(..)) where++import Control.Monad hiding + (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Data.Foldable+import Data.Traversable+import NumericPrelude hiding + (not, (&&), (||), Monad, Functor, (*>),+ (>>=), (>>), return, fail, fmap, mapM, mapM_, sequence, sequence_, (=<<), foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem+ )+ +import Control.Applicative (Applicative(..), (<$>))+import qualified NumericPrelude as Prelude++infixr 3 &&+infixr 2 ||++class Boolean b where+ true, false :: b+ not :: b -> b+ (&&), (||) :: b -> b -> b++instance Boolean Bool where+ true = True+ false = False+ not = Prelude.not+ (&&) = (Prelude.&&)+ (||) = (Prelude.||)
+ Language/Paraiso/Tensor.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances,+ MultiParamTypeClasses, NoImplicitPrelude, StandaloneDeriving, + TypeOperators, UndecidableInstances #-} +{-# OPTIONS -Wall #-}+-- | A tensor algebra library. Main ingredients are :+-- +-- 'Vec' and ':~' are data constructors for rank-1 tensor.+-- This is essentially a touple of objects of the same type.+-- +-- 'Vector' is a class for rank-1 tensor.+--+-- 'Axis' is an object for accessing the tensor components.++module Language.Paraiso.Tensor+ (+ (:~)(..), Vec(..), Axis(..), (!),+ Vector(..), VectorRing(..),+ contract,+ Vec0, Vec1, Vec2, Vec3, Vec4+ ) where++import qualified Algebra.Additive as Additive+import qualified Algebra.Ring as Ring+import Language.Paraiso.Failure+import Language.Paraiso.Prelude++infixl 9 !+-- | a component operator.+(!) :: Vector v => v a -> Axis v -> a+v ! i = component i v ++-- | data constructor for 0-dimensional tensor.+data Vec a = Vec +infixl 3 :~+-- | data constructor for constructing n+1-dimensional tensor+-- from n-dimensional tensor.+data n :~ a = (n a) :~ a++deriving instance (Eq a) => Eq (Vec a)+deriving instance (Eq a, Eq (n a)) => Eq (n :~ a)+deriving instance (Ord a) => Ord (Vec a)+deriving instance (Ord a, Ord (n a)) => Ord (n :~ a)+deriving instance (Show a) => Show (Vec a)+deriving instance (Show a, Show (n a)) => Show (n :~ a)+deriving instance (Read a) => Read (Vec a)+deriving instance (Read a, Read (n a)) => Read (n :~ a)++instance Foldable Vec where+ foldMap = foldMapDefault+instance Functor Vec where+ fmap = fmapDefault+instance Traversable Vec where+ traverse _ Vec = pure Vec +instance Applicative Vec where+ pure _ = Vec+ _ <*> _ = Vec++instance (Traversable n) => Foldable ((:~) n) where+ foldMap = foldMapDefault+instance (Traversable n) => Functor ((:~) n) where+ fmap = fmapDefault+instance (Traversable n) => Traversable ((:~) n) where+ traverse f (x :~ y) = (:~) <$> traverse f x <*> f y+instance (Applicative n, Traversable n) => Applicative ((:~) n) where+ pure x = pure x :~ x+ (vf :~ f) <*> (vx :~ x) = (vf <*> vx :~ f x)++++-- | An coordinate 'Axis' , labeled by an integer. +-- Axis also carries v, the container type for its corresponding+-- vector. Therefore, An axis of one type can access only vectors+-- of a fixed dimension, but of arbitrary type.+newtype Axis v = Axis {axisIndex::Int} deriving (Eq,Ord,Show,Read)++-- | An object that allows component-wise access.+class (Traversable v) => Vector v where+ -- | Get a component within f, a context which allows 'Failure'.+ componentF :: (Failure StringException f) => + Axis v -- ^the axis of the component you want+ -> v a -- ^the target vector + -> f a -- ^the component, obtained within a 'Failure' monad+ + -- | Get a component. This computation may result in a runtime error,+ -- though, as long as the 'Axis' is generated from library functions+ -- such as 'compose', there will be no error.+ component :: Axis v -> v a -> a+ component axis vec = unsafePerformFailure $ componentF axis vec+ -- | The dimension of the vector.+ dimension :: v a -> Int+ -- | Create a 'Vector' from a function that maps + -- axis to components.+ compose :: (Axis v -> a) -> v a+ +instance Vector Vec where+ componentF axis Vec + = failureString $ "axis out of bound: " ++ show axis+ dimension _ = 0+ compose _ = Vec ++instance (Vector v) => Vector ((:~) v) where+ componentF (Axis i) vx@(v :~ x) + | i==dimension vx - 1 = return x+ | True = componentF (Axis i) v+ dimension (v :~ _) = 1 + dimension v+ compose f = let+ xs = compose (\(Axis i)->f (Axis i)) in xs :~ f (Axis (dimension xs))++-- | Vector whose components are additive is also additive.+instance (Additive.C a) => Additive.C (Vec a) where+ zero = compose $ const Additive.zero+ x+y = compose (\i -> component i x + component i y)+ x-y = compose (\i -> component i x - component i y)+ negate x = compose (\i -> negate $ component i x)+ +instance (Vector v, Additive.C a) => Additive.C ((:~) v a) where+ zero = compose $ const Additive.zero+ x+y = compose (\i -> component i x + component i y)+ x-y = compose (\i -> component i x - component i y)+ negate x = compose (\i -> negate $ component i x)++-- | Tensor contraction. Create a 'Vector' from a function that maps +-- axis to component, then sums over the axis and returns a+contract :: (Vector v, Additive.C a) => (Axis v -> a) -> a+contract f = foldl (+) Additive.zero (compose f)++++-- | 'VectorRing' is a 'Vector' whose components belongs to 'Ring.C', +-- thus providing unit vectors.+class (Vector v, Ring.C a) => VectorRing v a where+ -- | A vector where 'Axis'th component is unity but others are zero.+ unitVectorF :: (Failure StringException f) => Axis v -> f (v a)+ -- | pure but unsafe version means of obtaining a 'unitVector'+ unitVector :: Axis v -> v a+ unitVector = unsafePerformFailure . unitVectorF+ +instance (Ring.C a) => VectorRing Vec a where+ unitVectorF axis+ = failureString $ "axis out of bound: " ++ show axis++instance (Ring.C a, VectorRing v a, Additive.C (v a)) + => VectorRing ((:~) v) a where+ unitVectorF axis@(Axis i) = ret+ where+ z = Additive.zero+ d = dimension z+ ret+ | i < 0 || i >= d = failureString $ "axis out of bound: " ++ show axis+ | i == d-1 = return $ Additive.zero :~ Ring.one+ | 0 <= i && i < d-1 = liftM (:~ Additive.zero) $ unitVectorF (Axis i)+ | True = return z + -- this last guard never matches, but needed to infer the type of z.++-- | Type synonyms+type Vec0 = Vec+type Vec1 = (:~) Vec0+type Vec2 = (:~) Vec1+type Vec3 = (:~) Vec2+type Vec4 = (:~) Vec3
+ Paraiso.cabal view
@@ -0,0 +1,144 @@+-- Paraiso.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.++-- cabal cheatsheet+-- cabal init : initialize .cabal+-- cabal check : detect format error +-- cabal haddock : create haddock documentation+-- cabal sdist : create tarball+-- cabal upload dist/Paraiso-....tar.gz : hackage debut!++-- The name of the package.+Name: Paraiso++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.0.0.0++-- A short (one-line) description of the package.+Synopsis: a code generator for partial differential equations solvers.++-- A longer description of the package.++Description: The purpose of this project is to design a high-level language+ for implementing explicit partial-differential equations solvers+ on supercomputers as well as today’s advanced personal+ computers.++ A language to describe the knowledge on algebraic concepts,+ physical equations, integration algorithms, optimization+ techniques, and hardware designs --- all the necessaries of the+ simulations in abstract, modular, re-usable and combinable forms.+ .++ > How to use+ .++ The module "Language.Paraiso.OM.Builder" contains the @Builder@+ monad, its typeclass instance declarations and functions that can+ be used to build Paraiso programs. Reserved words are @load@,+ @store@, @imm@, @loadIndex@, @shift@, @reduce@ and @broadcast@.+ .++ "Language.Paraiso.Tensor" is the library for tensor calculus of+ arbitrary rank and dimension. @Vector@ and @Axis@ are two main+ concepts. The type @Vector@ represents rank-1 tensor, and tensors+ of higher ranks are recursively defined as @Vector@ of+ @Vector@s. With @Axis@ you can refer to the components of+ @Vector@s, compose them, or contract them. Standalone usecases of+ @Tensor@ library and other components of Paraiso are found in:+ <https://github.com/nushio3/Paraiso/tree/master/attic>++ .++ * A document describing the current and the future designs :+ <https://github.com/nushio3/Paraiso/blob/master/paper/om.pdf> + .++ * Sample programs written in Paraiso :+ <https://github.com/nushio3/Paraiso/tree/master/examples> + .++ * The codes generated from the samples :+ <https://github.com/nushio3/Paraiso/tree/exampled/examples>+ .++ * The wiki :+ <http://www.paraiso-lang.org/wiki/>++-- URL for the project homepage or repository.+Homepage: http://www.paraiso-lang.org/wiki/index.php/Main_Page++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Takayuki Muranushi++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: muranushi@gmail.com++-- A copyright notice.+-- Copyright: ++Category: Language++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.6+++Library+ -- Modules exported by the library.+ Exposed-modules: Language.Paraiso+ Language.Paraiso.Failure+ Language.Paraiso.Generator+ Language.Paraiso.Generator.Allocation+ Language.Paraiso.Generator.Cpp+ Language.Paraiso.Interval+ Language.Paraiso.Name + Language.Paraiso.OM.Arithmetic+ Language.Paraiso.OM.Builder+ Language.Paraiso.OM.Builder.Boolean+ Language.Paraiso.OM.Builder.Internal+ Language.Paraiso.OM.DynValue+ Language.Paraiso.OM.Graph+ Language.Paraiso.OM.Realm+ Language.Paraiso.OM.Reduce+ Language.Paraiso.OM.Value+ Language.Paraiso.Orthotope+ Language.Paraiso.PiSystem+ Language.Paraiso.POM+ Language.Paraiso.Prelude+ Language.Paraiso.Tensor+ + -- Packages needed in order to build this package.+ Build-depends: base >= 4.3.1 && < 4.4,+ containers >= 0.4.0 && < 0.5,+ control-monad-failure >= 0.7.0 && < 0.8,+ directory >= 1.1.0 && < 1.2,+ filepath >= 1.2.0 && < 1.3,+ fgl >= 5.4.2 && < 5.5,+ mtl >= 2.0.1 && < 2.1,+ numeric-prelude >= 0.2.1 && < 0.3,+ repa >= 2.0.0 && < 2.1+ -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +source-repository head+ type: git+ location: https://github.com/nushio3/Paraiso+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain