Paraiso 0.3.1.2 → 0.3.1.3

raw patch · 7 files changed

+58/−44 lines, 7 filesdep ~typelevel-tensorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: typelevel-tensor

API changes (from Hackage documentation)

Files

• Language/Paraiso/Generator/ClarisTrans.hs +8/−9
• Language/Paraiso/Generator/PlanTrans.hs +8/−6
• Language/Paraiso/OM/Builder.hs +1/−1
• Language/Paraiso/OM/Builder/Internal.hs +19/−5
• Language/Paraiso/OM/PrettyPrint.hs +7/−9
• Language/Paraiso/Prelude.hs +9/−8
• Paraiso.cabal +6/−6

@@ -13,8 +13,7 @@ import           Control.Monad  import qualified Data.Dynamic as Dyn import qualified Data.List as L-import qualified Data.ListLike as LL-import qualified Data.ListLike.String as LL+import qualified Data.Text as T import           Language.Paraiso.Generator.Claris import           Language.Paraiso.Name import           Language.Paraiso.Prelude@@ -43,7 +42,7 @@   instance Translatable Program where-  translate conf Program{topLevel = xs} = LL.unlines $ map (translate conf) xs+  translate conf Program{topLevel = xs} = T.unlines $ map (translate conf) xs  instance Translatable Statement where       translate conf stmt = case stmt of@@ -107,13 +106,13 @@     where       ret = if fileType conf == HeaderFile then funcDecl else funcDef       funcDecl-        = LL.unwords+        = T.unwords           [ translate conf (funcType f)           , funcName'           , paren Paren $ joinBy ", " $ map (translate conf) (funcArgs f)           , ";"]       funcDef -        = LL.unwords+        = T.unwords           [ translate conf (funcType f)           , funcName'           , paren Paren $ joinBy ", " $ map (translate conf) (funcArgs f)@@ -155,7 +154,7 @@       Nothing  -> error $ "cannot translate value of Haskell type: " ++ show x  instance Translatable Var where-  translate conf (Var typ nam) = LL.unwords [translate conf typ, nameText nam]+  translate conf (Var typ nam) = T.unwords [translate conf typ, nameText nam]  instance Translatable Expr where   translate conf expr = ret@@ -174,8 +173,8 @@         MemberAccess x y       -> pt x ++ "." ++ t y         Op1Prefix op x         -> op ++ pt x         Op1Postfix op x        -> pt x ++ op-        Op2Infix op x y        -> LL.unwords [pt x, op, pt y]-        Op3Infix op1 op2 x y z -> LL.unwords [pt x, op1, pt y, op2, pt z]+        Op2Infix op x y        -> T.unwords [pt x, op, pt y]+        Op3Infix op1 op2 x y z -> T.unwords [pt x, op1, pt y, op2, pt z]         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.@@ -225,7 +224,7 @@       SlashStar  -> ("/*","*/")        joinBy :: Text -> [Text] -> Text-joinBy sep xs = LL.concat $ L.intersperse sep xs+joinBy sep xs = T.concat $ L.intersperse sep xs  joinEndBy :: Text -> [Text] -> Text joinEndBy sep xs = joinBy sep xs ++ sep

@@ -14,8 +14,6 @@ import           Data.Dynamic import qualified Data.Graph.Inductive                as FGL import           Data.List (sortBy)-import qualified Data.ListLike.String                as LL-import           Data.ListLike.Text () import qualified Data.Foldable                       as F import           Data.Maybe import qualified Data.Set                            as Set@@ -28,6 +26,7 @@ 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           Language.Paraiso.Generator.ClarisTrans (typeRepDB) import qualified Language.Paraiso.Generator.Native   as Native import qualified Language.Paraiso.Generator.Plan     as Plan import qualified Language.Paraiso.OM                 as OM@@ -67,7 +66,7 @@   }   where     env = Env setup plan-    comments = (:[]) $ C.Comment $ LL.unlines [ +    comments = (:[]) $ C.Comment $ T.unlines [        "",       "lowerMargin = " ++ showT (Plan.lowerMargin plan),       "upperMargin = " ++ showT (Plan.upperMargin plan)@@ -306,7 +305,7 @@            makeRawSubArg env True  (Plan.labNodesIn subker) ++            makeRawSubArg env False (Plan.labNodesOut subker),           C.funcBody = -          [ C.Comment $ LL.unlines +          [ C.Comment $ T.unlines              [ "",               "lowerMargin = " ++ showT (Plan.lowerBoundary subker),               "upperMargin = " ++ showT (Plan.upperBoundary subker)@@ -328,7 +327,7 @@           if rlm == Realm.Scalar            then loopMaker env rlm subker           else-            [ C.Comment $ LL.unlines +            [ C.Comment $ T.unlines                [ "",                 "lowerMargin = " ++ showT (Plan.lowerBoundary subker),                 "upperMargin = " ++ showT (Plan.upperBoundary subker)@@ -369,7 +368,7 @@           if rlm == Realm.Scalar            then loopMaker env rlm subker           else-            [ C.Comment $ LL.unlines +            [ C.Comment $ T.unlines                [ "",                 "lowerMargin = " ++ showT (Plan.lowerBoundary subker),                 "upperMargin = " ++ showT (Plan.upperBoundary subker)@@ -701,6 +700,9 @@   (Arith.Acos   , [x])  -> C.FuncCallStd "acos" [x]   (Arith.Atan   , [x])  -> C.FuncCallStd "atan" [x]   (Arith.Atan2  , [x,y])  -> C.FuncCallStd "atan2" [x,y]+  (Arith.Cast tr, [x])  -> case typeRepDB tr of+                                Just typeRepStr -> C.FuncCallStd ("(" ++ typeRepStr ++ ")") [x]+                                _               -> x   _ -> C.FuncCallStd (T.map toLower $ showT op) argExpr   where     nmsp a b = case Native.language setup of

@@ -16,7 +16,7 @@      reduce, broadcast,       loadIndex, loadSize,       shift, imm, -     cast,+     cast, castTo,      annotate, (<?>),      withAnnotation     ) where

@@ -18,7 +18,7 @@      reduce, broadcast,      loadIndex,loadSize,      shift, -     imm, mkOp1, mkOp2, cast,+     imm, mkOp1, mkOp2, cast, castTo,      annotate, (<?>),      withAnnotation     ) where@@ -417,19 +417,33 @@         acos = mkOp1 A.Acos         atan = mkOp1 A.Atan --- | take a phantom object 'c2', and perform the cast that keeps the realm while+-- | Perform the cast that keeps the realm while --   change the content type from 'c1' to 'c2'.-cast :: (TRealm r, Typeable c1,Typeable c2) => c2 -> (Builder v g a (Value r c1)) -> (Builder v g a (Value r c2))-cast c2 builder1 = do+cast :: (TRealm r, Typeable c1,Typeable c2) => (Builder v g a (Value r c1)) -> (Builder v g a (Value r c2))+cast builder1 = do+  c2 <- (return undefined) `asTypeOf` (fmap Val.content $ cast builder1)   v1 <- builder1   let        r1 = Val.realm v1       c1 = Val.content v1   n1 <- valueToNode v1   n0 <-  addNodeE [n1] $ NInst (Arith $ A.Cast $ Dynamic.typeOf c2) -  n01 <- addNodeE [n0] $ NValue (toDyn v1) +  n01 <- addNodeE [n0] $ NValue (toDyn v1{Val.content = c2})    return $ FromNode r1 c2 n01 ++-- | take a phantom object 'c2', and perform the cast that keeps the realm while+--   change the content type from 'c1' to 'c2'.+castTo :: (TRealm r, Typeable c1,Typeable c2) => c2 -> (Builder v g a (Value r c1)) -> (Builder v g a (Value r c2))+castTo c2 builder1 = do+  v1 <- builder1+  let +      r1 = Val.realm v1+      c1 = Val.content v1+  n1 <- valueToNode v1+  n0 <-  addNodeE [n1] $ NInst (Arith $ A.Cast $ Dynamic.typeOf c2) +  n01 <- addNodeE [n0] $ NValue (toDyn v1{Val.content = c2}) +  return $ FromNode r1 c2 n01   

@@ -12,8 +12,6 @@ import qualified Data.Set                               as Set import qualified Data.Text                              as T import qualified Data.Vector                            as V-import qualified Data.ListLike.String                   as LL-import qualified Data.ListLike.Text () import qualified Language.Paraiso.Annotation            as Anot import qualified Language.Paraiso.Annotation.Allocation as Alloc import qualified Language.Paraiso.Annotation.Boundary   as Boundary@@ -39,7 +37,7 @@ -- | pretty print the OM with your choice of prettyprinter for annotation. prettyPrintA :: Opt.Ready v g => (a -> [T.Text]) -> OM v g a -> T.Text prettyPrintA ppAnot om -  = LL.unlines +  = T.unlines      [ "OM name: " ++ nameText om,       "** Static Variables",       staticList,@@ -47,14 +45,14 @@       kernelList     ]   where-    staticList = LL.unlines $ V.toList $ V.map showT $ staticValues $ setup om-    kernelList = LL.unlines $ V.toList $ V.map ppKern $ kernels om+    staticList = T.unlines $ V.toList $ V.map showT $ staticValues $ setup om+    kernelList = T.unlines $ V.toList $ V.map ppKern $ kernels om -    ppKern kern = LL.unlines $ ["*** Kernel name: " ++ nameText kern] ++ concat (body (dataflow kern))+    ppKern kern = T.unlines $ ["*** Kernel name: " ++ nameText kern] ++ concat (body (dataflow kern))     body graph = map ppCon $ map (FGL.context graph) $ FGL.nodes graph      ppCon (input, idx, nodeLabel, output) -      = LL.unwords+      = T.unwords         [ showT idx,            ppNode nodeLabel,           ppEdges "<-" input,@@ -69,7 +67,7 @@      ppEdges symbol xs        | length xs == 0 = ""-      | otherwise      = LL.unwords $ symbol : map ppEdge (sort xs)+      | otherwise      = T.unwords $ symbol : map ppEdge (sort xs)     ppEdge (e, i) = case e of       EUnord -> showT i       EOrd x -> "(" ++ showT x ++ ")" ++ showT i@@ -95,7 +93,7 @@     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+    ppValid (Boundary.Valid xs) = T.unwords $ map ppInterval xs     ppInterval (Interval x y)        = ppNB x ++ ".." ++ ppNB y     ppInterval Empty = "[empty]" 

@@ -13,13 +13,11 @@     (mapM_, sequence_, forM_, msum, mapM, sequence, forM) -} -import           Data.ListLike (append)-import           Data.ListLike.Text ()-import qualified Data.ListLike.Base (ListLike) import qualified Data.Text as Text import qualified NumericPrelude as Prelude  import NumericPrelude hiding ((++), (||), (&&), not)+import qualified Prelude  -- | An efficient String that is used thoroughout Paraiso modules. type Text = Text.Text@@ -31,11 +29,14 @@ infixr 2  || infixr 5  ++ -(++) :: forall full item .-        Data.ListLike.Base.ListLike full item =>-        full -> full -> full--(++) = append+class Appendable a where+  (++) :: a -> a -> a+  +instance Appendable [a] where+  (++) = (Prelude.++)+  +instance Appendable Text.Text where+  (++) = Text.append  class Boolean b where   true, false :: b

@@ -15,7 +15,7 @@ -- 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.1.2
+Version:             0.3.1.3
 Tested-With:         GHC==7.4.1
 
 -- A short (one-line) description of the package.
@@ -153,20 +153,20 @@                        directory             >= 1.0    ,
                        filepath              >= 1.2.0  ,
                        fgl                   >= 5.4.2  ,
-                       ListLike              >= 3.1.1  ,
-                       listlike-instances    >= 0.1    ,
+                       --ListLike              >= 3.1.1  ,
+                       --listlike-instances    >= 0.1    ,
                        mtl                   >= 2.0.1  ,
                        numeric-prelude       >= 0.2    ,
                        random                >= 1.0.0  ,
                        text                  >= 0.11.1 ,
-                       typelevel-tensor      >= 0.1    ,
+                       typelevel-tensor      >= 0.1 && <1,
                        vector                >= 0.7.1  
   -- 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
+  ghc-options:     -Wall -O2  -fspec-constr-count=25
 
 
   Default-Language: Haskell2010
@@ -191,7 +191,7 @@                      numeric-prelude       >= 0.2    ,
                      random                >= 1.0.0  ,
                      text                  >= 0.11.1 ,
-                     typelevel-tensor      >= 0.1    ,
+                     typelevel-tensor      >= 0.1.1 && <1 ,
                      vector                >= 0.7.1  ,
 
                      test-framework,