Paraiso 0.2.0.3 → 0.3.0.0

raw patch · 20 files changed

+632/−387 lines, 20 filesdep −processdep ~ListLikedep ~directorydep ~filepathPVP ok

version bump matches the API change (PVP)

Dependencies removed: process

Dependency ranges changed: ListLike, directory, filepath, listlike-instances, numeric-prelude, vector

API changes (from Hackage documentation)

Files

• Language/Paraiso/Annotation/Boundary.hs +10/−3
• Language/Paraiso/Generator.hs +3/−1
• Language/Paraiso/Generator/Claris.hs +35/−1
• Language/Paraiso/Generator/ClarisTrans.hs +8/−7
• Language/Paraiso/Generator/Native.hs +15/−8
• Language/Paraiso/Generator/OMTrans.hs +20/−16
• Language/Paraiso/Generator/Plan.hs +13/−9
• Language/Paraiso/Generator/PlanTrans.hs +203/−82
• Language/Paraiso/Name.hs +3/−1
• Language/Paraiso/OM.hs +2/−2
• Language/Paraiso/OM/Builder.hs +1/−0
• Language/Paraiso/OM/Builder/Internal.hs +46/−25
• Language/Paraiso/OM/PrettyPrint.hs +11/−6
• Language/Paraiso/OM/Realm.hs +29/−14
• Language/Paraiso/OM/Value.hs +1/−1
• Language/Paraiso/Optimization/BoundaryAnalysis.hs +3/−3
• Language/Paraiso/Optimization/DecideAllocation.hs +3/−5
• Language/Paraiso/Tuning/Genetic.hs +5/−2
• Paraiso.cabal +204/−201
• runtests.hs +17/−0

@@ -2,12 +2,14 @@ UndecidableInstances #-} {-# OPTIONS -Wall #-} --- | calculate the 'Valid' regions of the 'Orthotope' where all information needed to update +-- | calculate the 'Valid' regions for each 'Orthotope' value +--   where all information needed to update  --   the region is available.+--   also annotates the global boundary condition.  module Language.Paraiso.Annotation.Boundary     (-     Valid(..), NearBoundary(..)+     Valid(..), NearBoundary(..), Condition(..)     ) where  import Data.Dynamic@@ -28,4 +30,9 @@ -- | the displacement around either side of the boundary. data NearBoundary a = NegaInfinity | LowerBoundary a | UpperBoundary a | PosiInfinity               deriving (Eq, Ord, Show, Typeable)-                       ++-- | type for global boundary conditions                       +data Condition+     = Open   -- ^ open boundary; do not touch anything+     | Cyclic -- ^ cyclic boundary; data out of the bounds are copied from the other side+     deriving (Eq, Read, Show)

@@ -42,7 +42,7 @@ generate setup om =     [ (headerFn, C.translate C.headerFile prog),     (cppFn   , C.translate C.sourceFile prog)-  ]+  ] ++ Plan.commonLibraries   where     prog0 =        Plan.translate setup $@@ -64,4 +64,6 @@     sourceExt = case Native.language setup of       Native.CPlusPlus -> "cpp"       Native.CUDA      -> "cu"++   

@@ -33,7 +33,11 @@   ) where  -import qualified Data.Dynamic as Dyn+import qualified Algebra.Additive as Additive+import qualified Algebra.Ring     as Ring+import qualified Algebra.IntegralDomain as IntegralDomain +import qualified Algebra.Field    as Field+import qualified Data.Dynamic     as Dyn import           Language.Paraiso.Name import           Language.Paraiso.Prelude import NumericPrelude@@ -176,6 +180,36 @@  instance Eq Expr where   (==)_ _= error "cannot compare Expr."++++++++instance Additive.C Expr where+  zero = toDyn (0::Int) -- type unsafe...+  (+) = Op2Infix "+"+  (-) = Op2Infix "-"+  negate = Op1Prefix "-"++instance Ring.C Expr where+  one = toDyn (1::Int)+  (*) = Op2Infix "*"+  fromInteger = toDyn++instance Field.C Expr where+  (/) = Op2Infix "/"+  recip = Op1Prefix "1/" -- wow...+  fromRational' x = let+    dx :: Double +    dx = fromRational' x+    in toDyn dx++instance IntegralDomain.C Expr where+  div = Op2Infix "/" -- I'm afraid...+  mod = Op2Infix "%"+  -- | make C++ type from Haskell objects typeOf :: (Dyn.Typeable a) => a -> TypeRep

@@ -6,7 +6,8 @@ module Language.Paraiso.Generator.ClarisTrans (         Translatable(..), paren,    joinBy, joinEndBy, joinBeginBy, joinBeginEndBy, -  headerFile, sourceFile, Context+  headerFile, sourceFile, Context,+  typeRepDB, dynamicDB   ) where  import           Control.Monad @@ -143,13 +144,13 @@  instance Translatable Dyn.TypeRep where     translate _ x = -    case msum $ map ($x) typeRepDB of+    case typeRepDB x of       Just str -> str       Nothing  -> error $ "cannot translate Haskell type: " ++ show x  instance Translatable Dyn.Dynamic where     translate _ x = -    case msum $ map ($x) dynamicDB of+    case dynamicDB x of       Just str -> str       Nothing  -> error $ "cannot translate value of Haskell type: " ++ show x @@ -178,12 +179,12 @@         ArrayAccess x y        -> pt x ++ paren Bracket (t y)         CommentExpr str x      -> t x ++ " " ++ paren SlashStar str ++ " " -- | The databeses for Haskell -> Cpp type name translations.-typeRepDB:: [Dyn.TypeRep -> Maybe Text]-typeRepDB = map fst symbolDB+typeRepDB:: Dyn.TypeRep -> Maybe Text+typeRepDB x = msum $ map (\cand -> fst cand $ x) symbolDB  -- | The databeses for Haskell -> Cpp immediate values translations.-dynamicDB:: [Dyn.Dynamic -> Maybe Text]-dynamicDB = map snd symbolDB+dynamicDB:: Dyn.Dynamic -> Maybe Text+dynamicDB x = msum $ map (\cand -> snd cand $ x) symbolDB  -- | The united database for translating Haskell types and immediate values to Cpp symbolDB:: [(Dyn.TypeRep -> Maybe Text, Dyn.Dynamic -> Maybe Text)]

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, KindSignatures #-}+{-# LANGUAGE CPP, FlexibleContexts, KindSignatures, StandaloneDeriving #-} {-# OPTIONS -Wall #-} -- | informations for generating native codes. @@ -8,18 +8,24 @@   Language(..)   ) where +import           Data.Tensor.TypeLevel import qualified Language.Paraiso.Optimization as Opt+import qualified Language.Paraiso.Annotation.Boundary as B  -- | the setups that needed to generate the native codes. data Setup (vector :: * -> *) (gauge :: *)   = Setup -    { language  :: Language, -- ^ the preferred native language-      directory :: FilePath, -- ^ the directory on which programs are to be generated-      optLevel  :: Opt.Level, -- ^ the intensity of optimization-      localSize :: vector gauge, -- ^ the dimension of the physically meaningful region-      cudaGridSize :: (Int, Int) -- ^ CUDA grid x block size (will be variable of subkernel in the future)-    } deriving (Show)+    { language     :: Language,          -- ^ the preferred native language+      directory    :: FilePath,          -- ^ the directory on which programs are to be generated+      optLevel     :: Opt.Level,         -- ^ the intensity of optimization+      localSize    :: vector gauge,      -- ^ the dimension of the physically meaningful region+      boundary     :: vector B.Condition,-- ^ the boundary condition imposed+      cudaGridSize :: (Int, Int)         -- ^ CUDA grid x block size (will be variable of subkernel in the future)+    }  +deriving instance (Show (v B.Condition), Show (v g))+ => Show (Setup v g)+ defaultSetup :: (Opt.Ready v g) => v g -> Setup v g defaultSetup sz   = Setup @@ -27,7 +33,8 @@     directory = "./",     optLevel = Opt.O3,     localSize = sz,-    cudaGridSize = (128, 128)+    boundary  = compose $ const B.Open,+    cudaGridSize = (32, 32)   }  data Language

@@ -101,15 +101,19 @@       validToLower valid = let Boundary.Valid xs = valid in-      compose $ \ax -> case Interval.lower (xs !! (axisIndex ax)) of-        Boundary.NegaInfinity    -> Additive.zero-        Boundary.LowerBoundary x -> x-        _                        -> error $ "wrong lower Margin! : " +      compose $ \ax -> case Native.boundary setup ! ax of+        Boundary.Cyclic -> Additive.zero+        _ -> case Interval.lower (xs !! (axisIndex ax)) of+             Boundary.NegaInfinity    -> Additive.zero+             Boundary.LowerBoundary x -> x+             _                        -> error $ "wrong lower Margin! : "      validToUpper valid = negate $ let Boundary.Valid xs = valid in-      compose $ \ax -> case Interval.upper (xs !! (axisIndex ax)) of-        Boundary.PosiInfinity    -> Additive.zero-        Boundary.UpperBoundary x -> x-        _                        -> error "wrong upper Margin!"+      compose $ \ax -> case Native.boundary setup ! ax of+        Boundary.Cyclic -> Additive.zero+        _ -> case Interval.upper (xs !! (axisIndex ax)) of+            Boundary.PosiInfinity    -> Additive.zero+            Boundary.UpperBoundary x -> x+            _                        -> error "wrong upper Margin!"      -- the intersection of the valid area of all the store instructions found in the om.     storageValidUnited :: (Opt.Ready v g) =>@@ -221,13 +225,13 @@   -                                                   /-         -------------                                  .-       /               \                         /    /-     /                   \           ______         /-    /                     \         \ |-   -               _ --    |                      |         \| | |   |        _ - -    \                     /        __  | | |   |     +                                                  /+         -------------                                .+       /  `._       __,'                        /    /+     /    ( (X))  ( (X) )\           ______         /+    /        (__/\__)     \         \ |-   -               _ -+    |         |rt++|       |         \| | |   |        _ - +    \         `----'      /        __  | | |   |           \   _ -- -- -- -- -- -- --  /    \\\ | |  _|                 _ .        '                .          ,_  ||| | | |  \       __  ---       /      -- -- -- -- -- -- --.__ ..  | | |   |@@ -247,7 +251,7 @@              |      '        \           /     ----\----|--- /-  /      \   |   /\     +  /      \   |   / \ -- __       ___      \               ______ /     --  /     \ - -- -- -- -- -- -| |-   -  |        |  ,          ,            | | |   |

@@ -12,9 +12,9 @@ module Language.Paraiso.Generator.Plan (   Plan(..), -  SubKernelRef(..), StorageRef(..), StorageIdx(..),+  SubKernelRef(..), StorageRef(..), StorageIdx(..), Referrer(..), -  dataflow, labNodesIn, labNodesOut, labNodesCalc,+  dataflow, labNodesIn, labNodesOut, labNodesCalc,    storageType                     ) where @@ -36,9 +36,9 @@       setup      :: OM.Setup v g a, -- ^ OM setup, includes all static variables       storages   :: V.Vector (StorageRef v g a), -- ^ Newly allocated Manifest variables       kernels    :: V.Vector (OM.Kernel v g a), -- ^ kernels-      subKernels :: V.Vector (SubKernelRef v g a), -- ^ -      lowerMargin :: v g,-      upperMargin :: v g+      subKernels :: V.Vector (SubKernelRef v g a), -- ^ subkernels+      lowerMargin :: v g, -- ^ the total lower margin of the OM, large enough to fit all the kernels+      upperMargin :: v g  -- ^ the total upper margin of the OM, large enough to fit all the kernels     }  instance Nameable (Plan v g a) where name = planName    @@ -64,7 +64,9 @@ instance Referrer (SubKernelRef v g a) (Plan v g a) where   parent = subKernelParent instance Nameable (SubKernelRef v g a) where-  name x = mkName $ nameText (parent x) ++ "_sub_" ++ showT (omWriteGroupIdx x)+  name x = let+    na = nameText $ kernels (parent x) V.! (kernelIdx x)+    in mkName $ "om_" ++ na ++ "_sub_" ++ showT (omWriteGroupIdx x) instance Realm.Realmable (SubKernelRef v g a) where   realm = subKernelRealm @@ -85,9 +87,11 @@   parent = storageRefParent instance Nameable (StorageRef v g a) where   name x = mkName $ case storageIdx x of-    StaticRef i     -> "static_" ++ showT i ++ "_" ++-                       nameText (OM.staticValues (setup $ parent x) V.! i)-    ManifestRef i j -> "manifest_"  ++ showT i ++ "_" ++ showT j+    StaticRef i     -> "om_s" ++ showT i ++ "_"+                       ++ nameText (OM.staticValues (setup $ parent x) V.! i)+    ManifestRef i j -> "om_m" ++ showT i ++ "_" ++ showT j+    +     instance Realm.Realmable (StorageRef v g a) where   realm x = let DVal.DynValue r _ = storageDynValue x in r 

@@ -1,9 +1,11 @@ {-# LANGUAGE CPP, DeriveDataTypeable, ExistentialQuantification, -NoImplicitPrelude, OverloadedStrings, TupleSections #-}+NoImplicitPrelude, OverloadedStrings, +TupleSections #-} {-# OPTIONS -Wall #-}  module Language.Paraiso.Generator.PlanTrans (-  translate+  translate,+  commonLibraries   ) where  @@ -18,13 +20,17 @@ import           Data.Maybe import qualified Data.Set                            as Set import           Data.Tensor.TypeLevel+import qualified Data.Tensor.TypeLevel.Axis          as Axis import qualified Data.Text                           as T+import qualified Data.Traversable                    as F import qualified Data.Vector                         as V import qualified Language.Paraiso.Annotation         as Anot+import qualified Language.Paraiso.Annotation.Boundary as Boundary import qualified Language.Paraiso.Annotation.SyncThreads as Sync import qualified Language.Paraiso.Generator.Claris   as C import qualified Language.Paraiso.Generator.Native   as Native import qualified Language.Paraiso.Generator.Plan     as Plan+import qualified Language.Paraiso.OM                 as OM import qualified Language.Paraiso.OM.Arithmetic      as Arith import qualified Language.Paraiso.OM.DynValue        as DVal import qualified Language.Paraiso.OM.Graph           as OM@@ -34,8 +40,11 @@ import           Language.Paraiso.Prelude hiding (Boolean(..)) import           NumericPrelude hiding ((++)) -+-- the standard annotation type. type AnAn = Anot.Annotation++-- the set of variable needed to construct various things,+-- this makes the functions a bit tedious... data Env v g = Env (Native.Setup v g) (Plan.Plan v g AnAn)  -- translate the plan to Claris@@ -44,14 +53,15 @@   C.Program    { C.progName = name plan,     C.topLevel = -      map include stlHeaders ++ +      stlHeaders ++        library env ++        comments ++       subHelperFuncs ++        [ C.ClassDef $ C.Class (name plan) $-        storageVars ++ +        map fst storageVars ++          constructorDef ++ -        memberFuncForSize env +++        accessorsForSize env +++        accessorsForVars env ++         subMemberFuncs ++ memberFuncs        ]   }@@ -69,15 +79,16 @@       (C.function  C.ConstructorType (name plan))       { C.funcMemberInitializer = -- allocate memory for storage members            concat $-           flip map storageVars $ \memb -> case memb of-             C.MemberVar _ var -> -               [C.FuncCallUsr (name var) [C.FuncCallStd "memorySize" []]]-             _ -> []+           flip map storageVars $ \(memb, stRef) -> +             case (memb, Realm.realm $ Plan.storageDynValue stRef) of+               (C.MemberVar _ var, Realm.Array)+                 -> [C.FuncCallUsr (name var) [C.FuncCallUsr (name (omFuncMemorySizeTotal env)) []]]+               _ -> []       }      memberFuncs =        V.toList $ -      V.imap (\idx ker -> makeFunc env idx ker) $ +      V.imap (\idx ker -> makeKernelFunc env idx ker) $        Plan.kernels plan      subHelperFuncs = concat $ V.toList $ V.map snd $ subKernelFuncs   @@ -85,52 +96,135 @@     subKernelFuncs = V.map (makeSubFunc env) $ Plan.subKernels plan  -    include = C.Exclusive C.HeaderFile . C.StmtPrpr . C.PrprInclude C.Chevron+    include   = C.Exclusive C.HeaderFile . C.StmtPrpr . C.PrprInclude C.Chevron+    include'' = C.Exclusive C.HeaderFile . C.StmtPrpr . C.PrprInclude C.Quotation2     stlHeaders = case Native.language setup of-      Native.CPlusPlus -> ["algorithm", "cmath", "vector"]-      Native.CUDA      -> ["thrust/device_vector.h", "thrust/host_vector.h", "thrust/functional.h", "thrust/extrema.h", "thrust/reduce.h"]+      Native.CPlusPlus -> map include ["algorithm", "cmath", "vector"]+      Native.CUDA      -> map include ["thrust/device_vector.h", "thrust/host_vector.h", "thrust/functional.h", "thrust/extrema.h", "thrust/reduce.h"] ++ +                          map (include'' . T.pack . fst) commonLibraries      storageVars =        V.toList $-      V.map storageRefToMenber $+      V.map storageRefToMember $       Plan.storages plan-    storageRefToMenber stRef =  -      C.MemberVar  C.Public $ +    storageRefToMember stRef =  +      (,stRef) $+      C.MemberVar C.Private $        C.Var          (mkCppType env $ Plan.storageType stRef)          (name stRef)  --- Generate member functions that returns the sizes of the mesh-memberFuncForSize :: Opt.Ready v g => Env v g -> [C.MemberDef]-memberFuncForSize env@(Env setup plan) = -  makeMami False  "size" size ++ -  makeMami True "lowerMargin" lM ++   -  makeMami True "upperMargin" uM ++   -  makeMami False  "memorySize" memorySize+-- | Generate member functions for accessing the static variables+accessorsForVars :: Opt.Ready v g => Env v g -> [C.MemberDef]+accessorsForVars env@(Env setup plan) =+  map (C.MemberFunc C.Public True) $ do+    -- list monad+    stRef <- (V.toList $ Plan.storages plan)+    +    -- we have accessors only for static values.+    Just na <- [accessorName stRef]+    +    -- for all static values we have simple accessors that returns reference to it.+    let typeSimple = C.RefOf $ mkCppType env $ Plan.storageType stRef+    let bodySimple = [C.StmtReturn $ mkVarExpr $ nameText stRef]+    let argsSimple = []+        +    -- we also have elemental accessors, but only for Arrays.    +    let typeElemMaybe = case Plan.storageDynValue stRef of +          DVal.DynValue Realm.Scalar _ -> []          +          DVal.DynValue Realm.Array  c -> [C.RefOf $ C.UnitType c]++    let argsElem = compose (\ax@(Axis i) -> +                             C.Var (C.typeOf (Native.localSize setup ! ax))+                                   (mkName $ "i" ++ showT i))+        bodyElem = (:[]) $+                   C.StmtReturn $ C.ArrayAccess (mkVarExpr $ nameText stRef) $+                   productedArgs ! Axis 0+        productedArgs = compose +          (\i -> +            if (Axis.next i == Axis 0) +            then (marginedArgs!i) +            else  (marginedArgs!i) ++                  (C.FuncCallUsr (name $ omFuncMemorySize env ! i) []) *+                                (productedArgs!(Axis.next i)))+        marginedArgs = compose (\i -> +                                  C.FuncCallUsr (name $ omFuncLowerMargin env ! i) [] ++                                  C.VarExpr (argsElem ! i))+                   +    let materials = (typeSimple, bodySimple, argsSimple) : fmap (,bodyElem,F.toList argsElem) typeElemMaybe+        +    (typ, bod, arg) <- materials+    +    return (C.function typ na){C.funcBody = bod, C.funcArgs = arg}    ++accessorName :: (Plan.StorageRef v g a) -> Maybe Name    +accessorName x = case Plan.storageIdx x of+    Plan.StaticRef i     -> Just $ name $ OM.staticValues (Plan.setup $ Plan.parent x) V.! i+    Plan.ManifestRef i j -> Nothing++++-- | Generate member functions that returns the sizes of the mesh+accessorsForSize :: Opt.Ready v g => Env v g -> [C.MemberDef]+accessorsForSize env =+  map (C.MemberFunc C.Public True) $+  ([omFuncLocalSizeTotal env, omFuncMemorySizeTotal env] ++) $+  concat $ +  map F.toList $+  [omFuncLocalSize env, omFuncMemorySize env, omFuncLowerMargin env, omFuncUpperMargin env]++omFuncLocalSizeTotal :: Opt.Ready v g => Env v g -> C.Function                               +omFuncLocalSize      :: Opt.Ready v g => Env v g -> v C.Function+omFuncLocalSizeTotal = fst $ makeOmSizeFuncSet "om_size" (\(Env setup _) -> Native.localSize setup)+omFuncLocalSize      = snd $ makeOmSizeFuncSet "om_size" (\(Env setup _) -> Native.localSize setup)++omFuncMemorySizeTotal :: Opt.Ready v g => Env v g -> C.Function                               +omFuncMemorySize      :: Opt.Ready v g => Env v g -> v C.Function+omFuncMemorySizeTotal = fst $ makeOmSizeFuncSet "om_memory_size" +                        (\(Env setup plan) -> Native.localSize setup + Plan.lowerMargin plan + Plan.upperMargin plan)+omFuncMemorySize      = snd $ makeOmSizeFuncSet "om_memory_size"+                        (\(Env setup plan) -> Native.localSize setup + Plan.lowerMargin plan + Plan.upperMargin plan)++omFuncLowerMargin     :: Opt.Ready v g => Env v g -> v C.Function+omFuncLowerMargin     = snd $ makeOmSizeFuncSet "om_lower_margin" (\(Env _ plan) -> Plan.lowerMargin plan)+omFuncUpperMargin     :: Opt.Ready v g => Env v g -> v C.Function+omFuncUpperMargin     = snd $ makeOmSizeFuncSet "om_upper_margin" (\(Env _ plan) -> Plan.upperMargin plan)++++makeOmSizeFuncSet :: Opt.Ready v g => +                        Text              -- ^ The header text+                     -> (Env v g -> v g)  -- ^ How to read the size from the environment+                     -> (Env v g -> C.Function, Env v g -> v C.Function)+makeOmSizeFuncSet header sizeVecReader = (prodFunc, elemFuncs)   where-    size = F.toList $ Native.localSize setup-    memorySize = F.toList $ Native.localSize setup + Plan.lowerMargin plan + Plan.upperMargin plan-    lM = F.toList $ Plan.lowerMargin plan-    uM = F.toList $ Plan.upperMargin plan+    -- reader monad+    prodFunc = do+      sizeVec <- sizeVecReader+      trivialFunc header $ product $ F.toList sizeVec+    elemFuncs = do+      sizeVec <- sizeVecReader+      F.sequenceA $ compose (\i -> trivialFunc (header ++ "_" ++ showT (axisIndex i)) (sizeVec ! i))  -    makeMami alone label xs = -      (if not alone then (finale label xs :) else id)  $-      map (\(i,x) -> tiro (label ++  show i) x) $-      zip [(0::Int)..] xs+    trivialFunc str ret = do+      sizeVec <- sizeVecReader+      gt <- gaugeType+      return $ (C.function gt $ mkName $ str)+          { C.funcBody = +            [ C.StmtReturn (C.toDyn ret)+            ]+          } -    tiro str ret =-      C.MemberFunc C.Public True $-      (C.function (C.typeOf (size!!0)) $ mkName $ T.pack str) -      { C.funcBody = -        [ C.StmtReturn (C.toDyn ret)-        ]-      }+-- | Generate member functions for accessing +       -    finale str xs = tiro str (product xs)+gaugeType :: Opt.Ready v g => Env v g -> C.TypeRep+gaugeType env@(Env setup plan) = C.typeOf $ Native.localSize setup ! (Axis 0)  -makeFunc :: Opt.Ready v g => Env v g -> Int -> OM.Kernel v g AnAn -> C.MemberDef-makeFunc env@(Env setup plan) kerIdx ker = C.MemberFunc C.Public False $ +-- Make Kernel Functions+makeKernelFunc :: Opt.Ready v g => Env v g -> Int -> OM.Kernel v g AnAn -> C.MemberDef+makeKernelFunc env@(Env setup plan) kerIdx ker = C.MemberFunc C.Public False $   (C.function tVoid (name ker))   { C.funcBody = kernelCalls ++ storeInsts  }@@ -200,7 +294,7 @@     cudaHelperName = mkName $ nameText subker ++ "_inner"          cudaBodys = -      if rlm == Realm.Global +      if rlm == Realm.Scalar        then []       else         (:[]) $@@ -231,7 +325,7 @@          makeSubArg env True (Plan.labNodesIn subker) ++          makeSubArg env False (Plan.labNodesOut subker),         C.funcBody = -          if rlm == Realm.Global +          if rlm == Realm.Scalar            then loopMaker env rlm subker           else             [ C.Comment $ LL.unlines @@ -258,12 +352,9 @@         _ -> error "NValue expected"       extractor typ = case Realm.realm typ of-      Realm.Local ->           -        C.FuncCallStd "thrust::raw_pointer_cast" .-        (:[]) .-        C.Op1Prefix "&*" .-        flip C.MemberAccess (C.FuncCallStd "begin" []) -      Realm.Global ->+      Realm.Array ->           +        flip C.MemberAccess (C.FuncCallStd "raw" []) +      Realm.Scalar ->         id      cppSolution = @@ -275,7 +366,7 @@          makeSubArg env True (Plan.labNodesIn subker) ++          makeSubArg env False (Plan.labNodesOut subker),         C.funcBody = -          if rlm == Realm.Global +          if rlm == Realm.Scalar            then loopMaker env rlm subker           else             [ C.Comment $ LL.unlines @@ -315,7 +406,7 @@ -- | implement the loop for each subroutine loopMaker :: Opt.Ready v g => Env v g -> Realm.Realm -> Plan.SubKernelRef v g AnAn -> [C.Statement] loopMaker env@(Env setup plan) realm subker = case realm of-  Realm.Local ->+  Realm.Array ->     pragma ++     [ C.StmtFor        (C.VarDefSub loopCounter loopBegin) @@ -324,7 +415,7 @@       [C.VarDefSub addrCounter codecAddr] ++       loopContent     ]-  Realm.Global -> loopContent+  Realm.Scalar -> loopContent    where     pragma = @@ -338,38 +429,60 @@     loopStrideCuda   = mkVarExpr "blockDim.x * gridDim.x"              loopCounter = C.Var tSizet (mkName "i")+    -- the orthotope for entire input     memorySize   = F.toList $ Native.localSize setup + Plan.lowerMargin plan + Plan.upperMargin plan+    -- the region where we can make output.+    -- if we use open boundary, it's smaller than input     boundarySize = F.toList $ Native.localSize setup + Plan.lowerMargin plan + Plan.upperMargin plan-     - Plan.lowerBoundary subker - Plan.upperBoundary subker+     - (compose $ \ax -> case Native.boundary setup ! ax of+        Boundary.Open   -> Plan.lowerBoundary subker ! ax + Plan.upperBoundary subker ! ax+        Boundary.Cyclic -> Additive.zero)      codecDiv = -      [ if idx == 0 then (C.VarExpr loopCounter) else C.Op2Infix "/" (C.VarExpr loopCounter) (C.toDyn $ product $ take idx boundarySize) +      [ if idx == 0 then (C.VarExpr loopCounter) else (C.VarExpr loopCounter) / (C.toDyn $ product $ take idx boundarySize)        | idx <- [0..length boundarySize-1]]     codecMod = -      [ if idx == length codecDiv-1 then x else C.Op2Infix "%" x (C.toDyn $ boundarySize !! idx)+      [ if idx == length codecDiv-1 then x else x `mod`  (C.toDyn $ boundarySize !! idx)       | (idx, x) <- zip [0..] codecDiv]     codecModAdd = -      [ C.Op2Infix "+" x (C.toDyn $ Plan.lowerMargin plan ! (Axis idx))+      [ x + (C.toDyn $ Plan.lowerMargin plan ! (Axis idx))       | (idx, x) <- zip [0..] codecMod]     codecAddr =        if memorySize == boundarySize        then C.VarExpr loopCounter-      else foldl1 (C.Op2Infix "+")-           [ C.Op2Infix "*" x (C.toDyn $ product $ take idx  memorySize)+      else foldl1 (+)+           [ x * (C.toDyn $ product $ take idx  memorySize)            | (idx, x) <- zip [0..] codecModAdd]-    codecLoadIndex =-      [ C.Op2Infix "-" x (C.toDyn  ((Plan.lowerMargin plan - Plan.lowerBoundary subker) ! (Axis idx) ))+    codecLoadIndex cursor =+      [ let+           bnd = Native.boundary setup+           n      = C.toDyn $ memorySize !! idx +           protector x'+             | bnd ! Axis idx == Boundary.Open = x'+             | otherwise = (x'+n) `mod` n+        in protector $ x - C.toDyn((Plan.lowerMargin plan - Plan.lowerBoundary subker - cursor) ! (Axis idx) )       | (idx, x) <- zip [0..] codecMod]     codecLoadSize =       [ C.toDyn  (Native.localSize setup ! (Axis idx) )       | (idx, _) <- zip [0..] codecMod]-    codecCursor cursor = -      (C.Op2Infix "+" (C.VarExpr addrCounter) (C.toDyn summa))-      where-        summa = sum $-          [ cursor ! (Axis idx) * product (take idx memorySize)-          | (idx, _) <- zip [0..] memorySize] +    codecCursor cursor +      | F.all (==Boundary.Open) bnd = easySum+      | otherwise = normalSum                      +        where+          bnd = Native.boundary setup+          easySum = C.VarExpr addrCounter + C.toDyn hardCodeShift+          hardCodeShift = sum $+            [ cursor ! (Axis idx) * product (take idx memorySize)+            | (idx, _) <- zip [0..] memorySize]+          normalSum = foldl1 (+)+            [ let stride = C.toDyn $ product $ take idx  memorySize+                  n      = C.toDyn $ memorySize !! idx +                  protector x'+                    | bnd ! Axis idx == Boundary.Open = x'+                    | otherwise = (x'+n) `mod` n+              in stride * protector (x + C.toDyn (cursor ! Axis idx))+            | (idx, x) <- zip [0..] codecModAdd]        addrCounter = C.Var tSizet (mkName "addr_origin") @@ -390,16 +503,16 @@         lhs cursor expr =            if Set.member idx outputIdxSet           then C.StmtExpr $ flip (C.Op2Infix "=") expr $ case realm of-            Realm.Local ->+            Realm.Array ->               (C.ArrayAccess (C.VarExpr $ C.Var (C.UnitType c) (nodeNameUniversal idx)) (C.VarExpr addrCounter)) -            Realm.Global ->+            Realm.Scalar ->               C.VarExpr $ C.Var (C.UnitType c) (nodeNameUniversal idx)           else flip C.VarDefSub expr                 (C.Var (C.UnitType c) $ nodeNameCursored env idx cursor)      addSyncFunctions :: FGL.Node -> [C.Statement] -> [C.Statement]      addSyncFunctions idx = -      if realm /= Realm.Local ||+      if realm /= Realm.Array ||          Native.language setup /= Native.CUDA           then id          else foldl (.) id $ map adder anot@@ -441,19 +554,19 @@           creatVar idx' = C.VarExpr $ C.Var C.UnknownType (nodeNameUniversal idx')         in case inst of       _ | isInput     -> case realm of-        Realm.Local -> (C.ArrayAccess (creatVar idx) (codecCursor cursor), [])-        Realm.Global -> (creatVar idx, [])+        Realm.Array -> (C.ArrayAccess (creatVar idx) (codecCursor cursor), [])+        Realm.Scalar -> (creatVar idx, [])       OM.Imm dyn      -> (C.Imm dyn, [])       OM.Arith op     -> (rhsArith env' op (map (nodeToRhs env' cursor) prepre),                         map (,cursor) prepre)       OM.Shift v      -> case prepre of         [pre1] -> (nodeToRhs env' cursor' pre1, [(pre1,cursor')]) where cursor' = cursor - v         _      -> error $ "shift has not 1 pre!" ++ show idxInst ++  show prepre-      OM.LoadIndex ax -> (codecLoadIndex !! axisIndex ax, [])+      OM.LoadIndex ax -> (codecLoadIndex cursor !! axisIndex ax, [])       OM.LoadSize  ax -> (codecLoadSize  !! axisIndex ax, [])-      OM.Reduce op    -> let fname = T.pack ("reduce_" ++ map toLower (show op)) in+      OM.Reduce op    -> let fname = T.pack ("om_reduce_" ++ map toLower (show op)) in         (C.FuncCallStd fname (map creatVar prepre), [])-      OM.Broadcast    -> let fname = "broadcast" in+      OM.Broadcast    -> let fname = "om_broadcast" in         (C.FuncCallStd fname (map creatVar prepre), [])       _               -> (C.CommentExpr ("TODO : " ++ showT inst) (C.toDyn (42::Int)), []) @@ -486,21 +599,21 @@ -- | convert a DynValue to C type representation mkCppType :: Opt.Ready v g => Env v g -> DVal.DynValue -> C.TypeRep mkCppType env x = case x of-  DVal.DynValue Realm.Global c -> C.UnitType c-  DVal.DynValue Realm.Local  c -> containerType env c          +  DVal.DynValue Realm.Scalar c -> C.UnitType c+  DVal.DynValue Realm.Array  c -> containerType env c            containerType :: Env v g -> TypeRep -> C.TypeRep containerType (Env setup _) c = case Native.language setup of   Native.CPlusPlus -> C.TemplateType "std::vector" [C.UnitType c]-  Native.CUDA      -> C.TemplateType "thrust::device_vector" [C.UnitType c]+  Native.CUDA      -> C.TemplateType "thrust::thrust_vector" [C.UnitType c]   -- | convert a DynValue to raw-pointer type representation  --   for example used within CUDA kernel mkCudaRawType :: Opt.Ready v g => Env v g -> DVal.DynValue -> C.TypeRep mkCudaRawType env x = case x of-  DVal.DynValue Realm.Global c -> C.UnitType c-  DVal.DynValue Realm.Local  c -> containerRawType env c          +  DVal.DynValue Realm.Scalar c -> C.UnitType c+  DVal.DynValue Realm.Array  c -> containerRawType env c            containerRawType :: Env v g -> TypeRep -> C.TypeRep containerRawType (Env setup _) c = case Native.language setup of@@ -600,6 +713,14 @@     lib = case Native.language setup of       Native.CPlusPlus -> cpuLib       Native.CUDA      -> gpuLib-    cpuLib = "template <class T> T broadcast (const T& x) {\n  return x;\n}\ntemplate <class T> T reduce_sum (const std::vector<T> &xs) {\n  T ret = 0;\n  for (int i = 0; i < xs.size(); ++i) ret+=xs[i];\n  return ret;\n}\ntemplate <class T> T reduce_min (const std::vector<T> &xs) {\n  T ret = xs[0];\n  for (int i = 1; i < xs.size(); ++i) ret=std::min(ret,xs[i]);\n  return ret;\n}\ntemplate <class T> T reduce_max (const std::vector<T> &xs) {\n  T ret = xs[0];\n  for (int i = 1; i < xs.size(); ++i) ret=std::max(ret,xs[i]);\n  return ret;\n}\n"+    -- use draft.cpp to generate library+    cpuLib = "\ntemplate <class T> T om_broadcast (const T& x) {\n  return x;\n}\ntemplate <class T> T om_reduce_sum (const std::vector<T> &xs) {\n  T ret = 0;\n  for (int i = 0; i < xs.size(); ++i) ret+=xs[i];\n  return ret;\n}\ntemplate <class T> T om_reduce_min (const std::vector<T> &xs) {\n  T ret = xs[0];\n  for (int i = 1; i < xs.size(); ++i) ret=std::min(ret,xs[i]);\n  return ret;\n}\ntemplate <class T> T om_reduce_max (const std::vector<T> &xs) {\n  T ret = xs[0];\n  for (int i = 1; i < xs.size(); ++i) ret=std::max(ret,xs[i]);\n  return ret;\n}\n\n"+    gpuLib = "\ntemplate <class T> __device__ __host__ T om_broadcast (const T& x) {\n  return x;\n}\ntemplate <class T> T om_reduce_sum (const thrust::thrust_vector<T> &xs) {\n  return thrust::reduce(xs.device_vector().begin(), xs.device_vector().end(), 0, thrust::plus<T>());\n}\ntemplate <class T> T om_reduce_min (const thrust::thrust_vector<T> &xs) {\n  return *(thrust::min_element(xs.device_vector().begin(), xs.device_vector().end()));\n}\ntemplate <class T> T om_reduce_max (const thrust::thrust_vector<T> &xs) {\n  return *(thrust::max_element(xs.device_vector().begin(), xs.device_vector().end()));\n}\n\n" -    gpuLib =  "template <class T>\n__device__ __host__\nT broadcast (const T& x) {\n  return x;\n}\ntemplate <class T> T reduce_sum (const std::vector<T> &xs) {\n  T ret = 0;\n  for (int i = 0; i < xs.size(); ++i) ret+=xs[i];\n  return ret;\n}\ntemplate <class T> T reduce_min (const std::vector<T> &xs) {\n  T ret = xs[0];\n  for (int i = 1; i < xs.size(); ++i) ret=std::min(ret,xs[i]);\n  return ret;\n}\ntemplate <class T> T reduce_max (const std::vector<T> &xs) {\n  T ret = xs[0];\n  for (int i = 1; i < xs.size(); ++i) ret=std::max(ret,xs[i]);\n  return ret;\n}\n" ++ "template <class T> T reduce_sum (const thrust::device_vector<T> &xs) {\n  return thrust::reduce(xs.begin(), xs.end(), 0, thrust::plus<T>());\n}\ntemplate <class T> T reduce_min (const thrust::device_vector<T> &xs) {\n  return *(thrust::min_element(xs.begin(), xs.end()));\n}\ntemplate <class T> T reduce_max (const thrust::device_vector<T> &xs) {\n  return *(thrust::max_element(xs.begin(), xs.end()));\n}\n\n"++commonLibraries :: [(FilePath, Text)]+commonLibraries = [("om_thrust_vector.h", thrustVectorLib)]++thrustVectorLib :: Text++thrustVectorLib = "#pragma once\n\n#include <thrust/device_vector.h>\n#include <thrust/host_vector.h>\n#include <thrust/device_ptr.h>\n#include <iostream>\n\nnamespace thrust {\n\ntemplate <class T>\nclass thrust_vector {\npublic:\n  enum NewerFlag {\n    kHost,\n    kDevice,\n    kBoth\n  };\nprivate:\n  mutable thrust::host_vector<T> hv;\n  mutable thrust::device_vector<T> dv;\n  mutable NewerFlag newer_;\npublic:  \n\n  typedef typename thrust::host_vector<T>::size_type  size_type;\n  typedef T value_type;\n\n  thrust_vector () : newer_(kBoth) {}\n  thrust_vector (size_type n, const value_type &value = value_type()) :\n    hv(n, value), dv(n, value), newer_(kBoth) {}\n  thrust_vector (const thrust_vector<T> &v) :\n    hv(v.hv), dv(v.dv), newer_(kBoth) {}\n\n  const size_type size() const { return hv.size(); }\n\n  void bring_device () const {\n    if (kHost == newer_) {\n      dv = hv;\n      newer_ = kBoth;\n    }\n  }\n  void bring_host () const {\n    if (kDevice == newer_) {\n      hv = dv;\n      newer_ = kBoth;\n    }\n  }\n\n  thrust::host_vector<T> &host_vector() const {\n    bring_host();\n    return hv;\n  }\n  thrust::device_vector<T> &device_vector() const {\n    bring_device();\n    return dv;\n  }\n  \n  const T& operator[](const size_type n) const {\n    bring_host();\n    return hv[n];\n  }\n  T& operator[](const size_type n) {\n    bring_host();\n    newer_ = kHost;\n    return hv[n];\n  }\n  T* unsafe_raw_device () const {\n    return thrust::raw_pointer_cast(&*dv.begin());\n  }\n  T* unsafe_raw_host () const {\n    return &hv[0];\n  }\n  void unsafe_set_newer (NewerFlag n) {\n    newer_ = n;\n  }\n  \n  T* raw () const {\n    bring_device();\n    newer_ = kDevice;\n    return thrust::raw_pointer_cast(&*dv.begin());\n  }\n  typename thrust::device_vector<T>::iterator device_begin () {\n    bring_device();\n    return dv.begin();\n  }\n  typename thrust::device_vector<T>::iterator device_end () {\n    bring_device();\n    return dv.end();\n  }\n};\n\ntemplate<class T>\nT* raw(thrust::device_vector<T> &dv) {\n  return thrust::raw_pointer_cast(&*dv.begin());\n}\n\ntemplate<class T>\nT* raw(thrust::host_vector<T> &hv) {\n  return &hv[0];\n}\n\ntemplate<class T>\nT* raw(const thrust::thrust_vector<T> &tv) {\n  return tv.raw();\n}\n\n}\n"

@@ -47,6 +47,8 @@ namee (Named _ x) = x  deriving instance (Eq a) => Eq (Named a)-deriving instance (Ord a) => Ord (Named a)+instance (Ord a) => Ord (Named a) where+  (Named n a) `compare` (Named m b) = (a,n) `compare` (b,m)+   deriving instance (Show a) => Show (Named a) deriving instance (Read a) => Read (Named a)

@@ -29,13 +29,13 @@   Name                          -- ^The machine name.   -> a                          -- ^The annotation at the root level.   -> [Named DynValue]           -- ^The list of static variables.-  -> [(Name, Builder v g a ())] -- ^The list of pair of the kernel name and its builder.+  -> [Named (Builder v g a ())] -- ^The list of pair of the kernel name and its builder.   -> OM v g a                   -- ^The result. makeOM name0 a0 vars0 kerns    = OM {     omName  = name0,     setup   = setup0,-    kernels = V.fromList $ map (\(n,b) -> buildKernel setup0 n b) kerns+    kernels = V.fromList $ map (\(Named n b) -> buildKernel setup0 n b) kerns   }   where     setup0 = Setup { staticValues = V.fromList vars0, globalAnnotation = a0 }

@@ -11,6 +11,7 @@      BuilderOf,      buildKernel,      +     bind,      load, store, imm,      reduce, broadcast, shift,       loadIndex, loadSize,

@@ -13,6 +13,7 @@      B, BuilderOf,      buildKernel, initState,       modifyG, getG, freeNode, addNode, addNodeE, valueToNode, lookUpStatic,+     bind,      load, store,      reduce, broadcast,      shift, loadIndex,loadSize,@@ -156,12 +157,19 @@                                 " actual: " ++ nameStr name0 ++ "::" ++ show type0)   return $ StaticIdx ret ++-- | run the given builder monad, get the result graph node,+--   and wrap it in a 'return' monad for later use.+--   it is like binding a value to a monad-level identifier.+bind :: (Monad m, Functor m) => m a -> m (m a)+bind = fmap return+ -- | 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.+     -> B (Value r c) -- ^The loaded 'TArray' 'Value' as a result. load r0 c0 name0 = do   let        type0 = mkDyn r0 c0@@ -187,43 +195,43 @@   return ()  --- | Reduce over a 'TLocal' 'Value' +-- | Reduce over a 'TArray' 'Value'  -- using the specified reduction 'Reduce.Operator'--- to make a 'TGlobal' 'Value'+-- to make a 'TScalar' 'Value' reduce :: (Typeable c) =>            Reduce.Operator               -- ^The reduction 'Reduce.Operator'.-       -> Builder v g a (Value TLocal c)  -- ^The 'TLocal' 'Value' to be reduced.-       -> Builder v g a (Value TGlobal c) -- ^The 'TGlobal' 'Value' that holds the reduction result.+       -> Builder v g a (Value TArray c)  -- ^The 'TArray' 'Value' to be reduced.+       -> Builder v g a (Value TScalar c) -- ^The 'TScalar' 'Value' that holds the reduction result. reduce op builder1 = do    val1 <- builder1   let        c1 = Val.content val1-      type2 = mkDyn TGlobal c1+      type2 = mkDyn TScalar c1   n1 <- valueToNode val1   n2 <- addNodeE [n1] $ NInst (Reduce op)    n3 <- addNodeE [n2] $ NValue type2 -  return (FromNode TGlobal c1 n3)+  return (FromNode TScalar c1 n3) --- | Broadcast a 'TGlobal' 'Value' --- to make it a 'TLocal' 'Value'  +-- | Broadcast a 'TScalar' 'Value' +-- to make it a 'TArray' 'Value'   broadcast :: (Typeable c) => -             Builder v g a (Value TGlobal c) -- ^The 'TGlobal' 'Value' to be broadcasted.-          -> Builder v g a (Value TLocal c)  -- ^The 'TLocal' 'Value', all of them containing the global value.+             Builder v g a (Value TScalar c) -- ^The 'TScalar' 'Value' to be broadcasted.+          -> Builder v g a (Value TArray c)  -- ^The 'TArray' 'Value', all of them containing the global value. broadcast builder1 = do    val1 <- builder1   let        c1 = Val.content val1-      type2 = mkDyn TLocal c1+      type2 = mkDyn TArray c1   n1 <- valueToNode val1   n2 <- addNodeE [n1] $ NInst Broadcast    n3 <- addNodeE [n2] $ NValue type2 -  return (FromNode TLocal c1 n3)+  return (FromNode TArray c1 n3) --- | Shift a 'TLocal' 'Value' with a constant vector.+-- | Shift a 'TArray' 'Value' with a constant vector. shift :: (Typeable c)   => v g                            -- ^ The amount of shift  -  -> Builder v g a (Value TLocal c) -- ^ The 'TLocal' Value to be shifted-  -> Builder v g a (Value TLocal c) -- ^ The shifted 'TLocal' 'Value' as a result.+  -> Builder v g a (Value TArray c) -- ^ The 'TArray' Value to be shifted+  -> Builder v g a (Value TArray c) -- ^ The shifted 'TArray' 'Value' as a result. shift vec builder1 = do   val1 <- builder1   let @@ -232,25 +240,25 @@   n1 <- valueToNode val1   n2 <- addNodeE [n1] $ NInst $ Shift vec   n3 <- addNodeE [n2] $ NValue type1 -  return (FromNode TLocal c1 n3)+  return (FromNode TArray c1 n3) --- | Load the 'Axis' component of the mesh address, to a 'TLocal' 'Value'.+-- | Load the 'Axis' component of the mesh address, to a 'TArray' 'Value'. loadIndex :: (Typeable c) =>               c                            -- ^The 'Val.content' type.           -> Axis v                       -- ^ The axis for which index is required-          -> Builder v g a (Value TLocal c) -- ^ The 'TLocal' 'Value' that contains the address as a result.+          -> Builder v g a (Value TArray c) -- ^ The 'TArray' 'Value' that contains the address as a result. loadIndex c0 axis = do-  let type0 = mkDyn TLocal c0+  let type0 = mkDyn TArray c0   n0 <- addNodeE []   $ NInst (LoadIndex axis)   n1 <- addNodeE [n0] $ NValue type0 -  return (FromNode TLocal c0 n1)+  return (FromNode TArray c0 n1) --- | Load the 'Axis' component of the mesh size, to either a  'TGlobal' 'Value' or  'TLocal' 'Value'..+-- | Load the 'Axis' component of the mesh size, to either a  'TScalar' 'Value' or  'TArray' 'Value'.. loadSize :: (TRealm r, Typeable c)             => r                            -- ^ The 'TRealm'             -> c                            -- ^The 'Val.content' type.             -> Axis v                       -- ^ The axis for which the size is required-            -> Builder v g a (Value r c) -- ^ The 'TGlobal' 'Value' that contains the size of the mesh in that direction.+            -> Builder v g a (Value r c) -- ^ The 'TScalar' 'Value' that contains the size of the mesh in that direction. loadSize r0 c0 axis = do   let type0 = mkDyn r0 c0   n0 <- addNodeE []   $ NInst (LoadSize axis)@@ -262,7 +270,7 @@ -- '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.+    -> B (Value r c) -- ^'TArray' 'Value' with the @c@ stored. imm c0 = return (FromImm unitTRealm c0)  -- | Make a unary operator@@ -330,7 +338,7 @@   return $ FromNode r1 c1 n1   -- | (<?>) = annotate-infix 0 <?>+infixr 0 <?> (<?>) :: (TRealm r, Typeable c) => (a -> a) -> Builder v g a (Value r c) ->  Builder v g a (Value r c) (<?>) = annotate @@ -348,6 +356,19 @@   one = return $ FromImm unitTRealm Ring.one   (*) = mkOp2 A.Mul   fromInteger = imm . fromInteger+  a ^ n+   | n== 0 = fromInteger 1+   | n== 1 = a+   | True  = do+       ba <- fmap return a+       f ba n+       where+         f x 1  = x+         f x n2 = do+           let n3     = div n2 2+               modify = if n2 - 2*n3 > 0 then (x*) else id+           bx_n3 <- fmap return $ f x n3+           modify $ bx_n3*bx_n3  -- | Builder is Ring 'IntegralDomain.C'. -- You can use div and mod.

@@ -5,8 +5,10 @@   prettyPrint, prettyPrintA, prettyPrintA1   ) where +import           Control.Monad import qualified Data.Graph.Inductive                   as FGL import           Data.List (sort)+import           Data.Maybe import qualified Data.Set                               as Set import qualified Data.Text                              as T import qualified Data.Vector                            as V@@ -17,6 +19,7 @@ import qualified Language.Paraiso.Annotation.Boundary   as Boundary import qualified Language.Paraiso.Annotation.Dependency as Depend import qualified Language.Paraiso.Annotation.Execution  as Exec+import           Language.Paraiso.Generator.ClarisTrans (dynamicDB) import           Language.Paraiso.Interval import           Language.Paraiso.Name import           Language.Paraiso.OM@@ -59,8 +62,10 @@         ] : ppAnot (getA nodeLabel)      ppNode n = case n of-      NValue x _ -> showT x-      NInst  x _ -> showT x+      NValue x          _ -> showT x+      NInst  (Imm dynX) _ -> +        "Imm " ++ (fromJust $ dynamicDB dynX `mplus` Just (showT dynX))+      NInst  x          _ -> showT x      ppEdges symbol xs        | length xs == 0 = ""@@ -86,18 +91,18 @@       , map showT ((Anot.toList anots) ::  [Depend.KernelWriteGroup])               , map showT ((Anot.toList anots) ::  [Depend.OMWriteGroup])                       ]-      +     toValidList :: Opt.Ready v g => OM v g Anot.Annotation -> Anot.Annotation -> [Boundary.Valid g]           toValidList _ = Anot.toList-                   +     ppValid (Boundary.Valid xs) = LL.unwords $ map ppInterval xs     ppInterval (Interval x y)        = ppNB x ++ ".." ++ ppNB y     ppInterval Empty = "[empty]" -    +     ppNB (Boundary.NegaInfinity)    = "[-inf"         ppNB (Boundary.LowerBoundary x) = "[" ++ showT x     ppNB (Boundary.UpperBoundary x) = showT x ++ "]"     ppNB (Boundary.PosiInfinity)    = "+inf]"-    +     ppDC (Depend.Calc s) = showT $ Set.toList s

@@ -2,32 +2,43 @@ {-# 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.+-- 'Array' data are n-dimensional array that is distributed among nodes.+-- 'Scalar' data are single-point value, possibly reside in the master node.+-- .+-- Be noted that 'Array' and 'Scalar' were initially called 'Local' and 'Global'.+-- but I opted for more conventional notation. If you find any historical notation+-- remaining, please let me know! + module Language.Paraiso.OM.Realm   (-   TGlobal(..), TLocal(..), TRealm(..),+   TScalar(..), TArray(..), TRealm(..),    Realm(..),   Realmable(..),   ) where --- | Type-level representations+-- | Type-level representations of realm 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+-- | Type-level representation of 'Scalar' realm+data TScalar = TScalar+-- | Type-level representation of 'Array' realm+data TArray = TArray --- | Value-level representations-data Realm = Global | Local  deriving (Eq, Show)+instance TRealm TScalar where+  tRealm _ = Scalar +  unitTRealm = TScalar+instance TRealm TArray where+  tRealm _ = Array+  unitTRealm = TArray +-- | Value-level representations of realm+data Realm +  = Scalar -- ^ Value-level representation of 'Scalar' realm+  | Array  -- ^ Value-level representation of 'Array' realm+  deriving (Eq, Show)+ -- | Means of obtaining value-level realm from things class Realmable a where   realm :: a -> Realm@@ -35,5 +46,9 @@ -- | Realmable instances   instance Realmable Realm where   realm = id    +instance Realmable TScalar where+  realm = const Scalar+instance Realmable TArray where+  realm = const Array          

@@ -15,7 +15,7 @@   -- | value type, with its realm and content type discriminated in type level-data (R.TRealm rea, Typeable con) => +data   Value rea con =    -- | data obtained from the dataflow graph.   -- 'realm' carries a type-level realm information, 

@@ -42,7 +42,7 @@     memoAnot = V.generate (FGL.noNodes graph) calcAnot      calcAnot i = case selfNode of-      NValue v _           -> if isGlobal v +      NValue v _           -> if isScalar v                                then infinite                               else preAnot       NInst (Imm _)_       -> infinite@@ -61,8 +61,8 @@           Just x -> x           _      -> error $ "node[" ++ show i ++ "] disappeared" -        isGlobal v = case v of-          DVal.DynValue Realm.Global _ -> True+        isScalar v = case v of+          DVal.DynValue Realm.Scalar _ -> True           _                            -> False          -- data at all coordinates is valid that is stored in the array 

@@ -30,14 +30,12 @@       | afterLoad = Anot.set Alloc.Existing       | beforeStore || beforeReduce || afterReduce || beforeBroadcast || afterBroadcast                   = Anot.set Alloc.Manifest-      | (isGlobal || beforeShift || afterShift ) && False -- warehouse+      | (isScalar || beforeShift || afterShift ) && False -- warehouse                   = Anot.weakSet Alloc.Delayed       | otherwise = Anot.weakSet Alloc.Delayed . setChoice         where           self0 = FGL.lab graph i           pre0  = FGL.lab graph =<<(listToMaybe $ FGL.pre graph i) -          suc0  = FGL.lab graph =<<(listToMaybe $ FGL.suc graph i) -          pres  = catMaybes $ map (FGL.lab graph) $ FGL.pre graph i           sucs  = catMaybes $ map (FGL.lab graph) $ FGL.suc graph i            setChoice @@ -48,8 +46,8 @@             Just (NValue _ _) -> True             _                 -> False -          isGlobal  = case self0 of-            Just (NValue (DVal.DynValue Realm.Global _) _) -> True+          isScalar  = case self0 of+            Just (NValue (DVal.DynValue Realm.Scalar _) _) -> True             _                                              -> False           afterLoad = case pre0 of             Just (NInst (Load _) _)    -> True

@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, NoImplicitPrelude, PackageImports #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, NoImplicitPrelude, PackageImports,+ FlexibleContexts,  StandaloneDeriving, UndecidableInstances  #-} {-# OPTIONS -Wall #-} module Language.Paraiso.Tuning.Genetic   (@@ -31,7 +32,9 @@   Species {     setup   :: Native.Setup v g,     machine :: OM.OM v g Anot.Annotation-  } deriving (Show)+  } +deriving instance (Show (Native.Setup v g),  Show (OM.OM v g Anot.Annotation))+         => Show (Species v g)  makeSpecies :: Native.Setup v g -> OM.OM v g Anot.Annotation -> Species v g makeSpecies = Species

@@ -1,201 +1,204 @@--- 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.2.0.3-Tested-With:         GHC==7.0.3, GHC==7.4.1---- 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@, @loadSize@, @shift@, @reduce@ and-             @broadcast@. -             .-             Paraiso frontend uses "Data.Tensor.Typelevel"-             <http://hackage.haskell.org/package/typelevel-tensor>,-             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. See the wiki for more detail:-             <http://www.paraiso-lang.org/wiki/>-             .-             * 0.2.0.0 /Companion/ : genetic algorithm support for automated tuning.-             .-             * 0.1.0.0 /Binary/ : enhanced backend, code generator for OpenMP and CUDA-             .-             * 0.0.0.0 /Atmosphere/ : code generator for single CPU---- 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.10----flag test-  description: Build the executable to run unit tests-  default: True--Library-  -- Modules exported by the library.-  Exposed-modules:     Language.Paraiso-                       Language.Paraiso.Annotation-                       Language.Paraiso.Annotation.Allocation-                       Language.Paraiso.Annotation.Balloon-                       Language.Paraiso.Annotation.Boundary-                       Language.Paraiso.Annotation.Comment-                       Language.Paraiso.Annotation.Dependency-                       Language.Paraiso.Annotation.Execution-                       Language.Paraiso.Annotation.SyncThreads-                       Language.Paraiso.Failure-                       Language.Paraiso.Generator-                       Language.Paraiso.Generator.Claris-                       Language.Paraiso.Generator.ClarisTrans-                       Language.Paraiso.Generator.Native-                       Language.Paraiso.Generator.OMTrans-                       Language.Paraiso.Generator.Plan-                       Language.Paraiso.Generator.PlanTrans-                       Language.Paraiso.Interval-                       Language.Paraiso.Name        -                       Language.Paraiso.OM-                       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.PrettyPrint-                       Language.Paraiso.OM.Realm-                       Language.Paraiso.OM.Reduce-                       Language.Paraiso.OM.Value-                       Language.Paraiso.Optimization-                       Language.Paraiso.Optimization.BoundaryAnalysis-                       Language.Paraiso.Optimization.DeadCodeElimination-                       Language.Paraiso.Optimization.DecideAllocation-                       Language.Paraiso.Optimization.DependencyAnalysis-                       Language.Paraiso.Optimization.Graph-                       Language.Paraiso.Optimization.Identity-                       Language.Paraiso.Orthotope-                       Language.Paraiso.PiSystem-                       Language.Paraiso.Prelude-                       Language.Paraiso.Tuning.Genetic--  -- Packages needed in order to build this package.-  Build-depends:       array                 >= 0.2    && < 0.5,-                       base                  == 4.*,-                       containers            >= 0.4.0  && < 0.5,-                       control-monad-failure >= 0.7.0  && < 0.8,-                       directory             >= 1.0    && < 1.2,-                       filepath              >= 1.2.0  && < 1.4,-                       fgl                   >= 5.4.2  && < 5.5,-                       ListLike              >= 3.1.1  && < 3.2,-                       listlike-instances    >= 0.1    && < 0.2,-                       mtl                   >= 2.0.1  && < 2.1,-                       numeric-prelude       >= 0.2    && < 0.4,-                       process               >= 1.1    && < 1.2,-                       random                >= 1.0.0  && < 1.1,-                       text                  >= 0.11.1 && < 0.12,-                       typelevel-tensor      >= 0.1,-                       vector                >= 0.7.1  && < 0.8-  -- Modules not exported by this package.-  -- Other-modules:       -  -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.-  -- Build-tools:         -  ghc-options:    -O3 -Wall   -fspec-constr-count=25---  Default-Language: Haskell2010--source-repository head-    type:     git-    location: https://github.com/nushio3/Paraiso-    --test-suite runtests-    type: exitcode-stdio-1.0-    build-depends:     base                  == 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,-                       ListLike              >= 3.1.1  && < 3.2,-                       listlike-instances    >= 0.1    && < 0.2,-                       mtl                   >= 2.0.1  && < 2.1,-                       numeric-prelude       >= 0.2.1  && < 0.3,-                       process               >= 1.0.1  && < 1.0.2,-                       random                >= 1.0.0  && < 1.1,-                       text                  >= 0.11.1 && < 0.12,-                       typelevel-tensor      >= 0.1,-                       vector                >= 0.7.1  && < 0.7.2,--                       test-framework,-                       test-framework-quickcheck2,-                       test-framework-hunit,-                       HUnit,-                       QuickCheck >= 2 && < 3-    main-is: runtests.hs-    ghc-options:     -Wall -O3  -fspec-constr-count=25-    Default-Language: Haskell2010-+-- 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.3.0.0
+Tested-With:         GHC==7.4.1
+
+-- 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@, @loadSize@, @shift@, @reduce@ and
+             @broadcast@. 
+             .
+             Paraiso frontend uses "Data.Tensor.Typelevel"
+             <http://hackage.haskell.org/package/typelevel-tensor>,
+             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. See the wiki:
+             <http://www.paraiso-lang.org/wiki/> and the paper:
+             <http://arxiv.org/abs/1204.4779> for more detail.
+
+             * 0.3.0.0 /Doughnut/ : refined interface and support for cyclic boundary conditions.
+             .
+             * 0.2.0.0 /Companion/ : genetic algorithm support for automated tuning.
+             .
+             * 0.1.0.0 /Binary/ : enhanced backend, code generator for OpenMP and CUDA
+             .
+             * 0.0.0.0 /Atmosphere/ : code generator for single CPU
+
+-- 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.10
+
+
+
+flag test
+  description: Build the executable to run unit tests
+  default: True
+
+Library
+  -- Modules exported by the library.
+  Exposed-modules:     Language.Paraiso
+                       Language.Paraiso.Annotation
+                       Language.Paraiso.Annotation.Allocation
+                       Language.Paraiso.Annotation.Balloon
+                       Language.Paraiso.Annotation.Boundary
+                       Language.Paraiso.Annotation.Comment
+                       Language.Paraiso.Annotation.Dependency
+                       Language.Paraiso.Annotation.Execution
+                       Language.Paraiso.Annotation.SyncThreads
+                       Language.Paraiso.Failure
+                       Language.Paraiso.Generator
+                       Language.Paraiso.Generator.Claris
+                       Language.Paraiso.Generator.ClarisTrans
+                       Language.Paraiso.Generator.Native
+                       Language.Paraiso.Generator.OMTrans
+                       Language.Paraiso.Generator.Plan
+                       Language.Paraiso.Generator.PlanTrans
+                       Language.Paraiso.Interval
+                       Language.Paraiso.Name        
+                       Language.Paraiso.OM
+                       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.PrettyPrint
+                       Language.Paraiso.OM.Realm
+                       Language.Paraiso.OM.Reduce
+                       Language.Paraiso.OM.Value
+                       Language.Paraiso.Optimization
+                       Language.Paraiso.Optimization.BoundaryAnalysis
+                       Language.Paraiso.Optimization.DeadCodeElimination
+                       Language.Paraiso.Optimization.DecideAllocation
+                       Language.Paraiso.Optimization.DependencyAnalysis
+                       Language.Paraiso.Optimization.Graph
+                       Language.Paraiso.Optimization.Identity
+                       Language.Paraiso.Orthotope
+                       Language.Paraiso.PiSystem
+                       Language.Paraiso.Prelude
+                       Language.Paraiso.Tuning.Genetic
+
+  -- Packages needed in order to build this package.
+  Build-depends:       array                 >= 0.2    && < 0.5,
+                       base                  == 4.*,
+                       containers            >= 0.4.0  && < 0.5,
+                       control-monad-failure >= 0.7.0  && < 0.8,
+                       directory             >= 1.0    && < 1.2,
+                       filepath              >= 1.2.0  && < 1.4,
+                       fgl                   >= 5.4.2  && < 5.5,
+                       ListLike              >= 3.1.1  && < 3.3,
+                       listlike-instances    >= 0.1    && < 0.3,
+                       mtl                   >= 2.0.1  && < 2.1,
+                       numeric-prelude       >= 0.2    && < 0.4,
+                       random                >= 1.0.0  && < 1.1,
+                       text                  >= 0.11.1 && < 0.12,
+                       typelevel-tensor      >= 0.1,
+                       vector                >= 0.7.1  && < 0.10
+  -- Modules not exported by this package.
+  -- Other-modules:       
+  
+  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+  -- Build-tools:         
+  ghc-options:    -O3 -Wall   -fspec-constr-count=25
+
+
+  Default-Language: Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/nushio3/Paraiso
+  
+
+test-suite runtests
+  type: exitcode-stdio-1.0
+  Build-depends:     array                 >= 0.2    && < 0.5,
+                     base                  == 4.*,
+                     containers            >= 0.4.0  && < 0.5,
+                     control-monad-failure >= 0.7.0  && < 0.8,
+                     directory             >= 1.0    && < 1.2,
+                     filepath              >= 1.2.0  && < 1.4,
+                     fgl                   >= 5.4.2  && < 5.5,
+                     ListLike              >= 3.1.1  && < 3.3,
+                     listlike-instances    >= 0.1    && < 0.3,
+                     mtl                   >= 2.0.1  && < 2.1,
+                     numeric-prelude       >= 0.2    && < 0.4,
+                     random                >= 1.0.0  && < 1.1,
+                     text                  >= 0.11.1 && < 0.12,
+                     typelevel-tensor      >= 0.1,
+                     vector                >= 0.7.1  && < 0.10,
+
+                     test-framework,
+                     test-framework-quickcheck2,
+                     test-framework-hunit,
+                     HUnit,
+                     QuickCheck >= 2 && < 3
+  main-is: runtests.hs
+  ghc-options:     -Wall -O3  -fspec-constr-count=25
+  Default-Language: Haskell2010
+

@@ -0,0 +1,17 @@+import           Control.Exception (finally)+import           Control.Monad+import           Test.Framework (defaultMainWithArgs)+import qualified Test.Paraiso.Option as Option++-- Actual tests+import Test.Paraiso.Annotation+import Test.Paraiso.Claris +import Test.Paraiso.QuickCheckItself++main :: IO ()+main = +  flip defaultMainWithArgs Option.argv +    [testQuickCheckItself, +     testAnnotation, +     testClaris]+    `finally` when Option.help Option.printHelp