dph-common-vseg: add fusion-phases header and validPA
authorBen Lippmeier <benl@ouroborus.net>
Thu, 18 Aug 2011 02:09:46 +0000 (12:09 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Thu, 18 Aug 2011 02:09:46 +0000 (12:09 +1000)
dph-base/Data/Array/Parallel/Base.hs
dph-common-vseg/Data/Array/Parallel/PArray.hs
dph-common-vseg/Data/Array/Parallel/PArray/PData/Base.hs
dph-common-vseg/Data/Array/Parallel/PArray/PData/Nested.hs
dph-common-vseg/Data/Array/Parallel/PArray/PData/Scalar.hs
dph-common-vseg/dph-common-vseg.cabal
dph-common-vseg/include/fusion-phases-vseg.h [new file with mode: 0644]

index 2c1377f..e53f99b 100644 (file)
@@ -2,6 +2,7 @@
 module Data.Array.Parallel.Base (
   -- * Debugging infrastructure
   module Data.Array.Parallel.Base.Debug,
+  module Data.Array.Parallel.Base.Config,
 
   -- * Data constructor tags
   module Data.Array.Parallel.Base.Util,
@@ -17,6 +18,7 @@ module Data.Array.Parallel.Base (
   ST(..), runST
 ) where
 import Data.Array.Parallel.Base.Debug
+import Data.Array.Parallel.Base.Config
 import Data.Array.Parallel.Base.Util
 import Data.Array.Parallel.Base.Text
 import Data.Array.Parallel.Base.DTrace
index 8111e34..442d453 100644 (file)
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+#include "fusion-phases-vseg.h"
 
 -- | Functions that work directly on PArrays.
 
@@ -14,6 +16,7 @@ module Data.Array.Parallel.PArray
         , unpackPA
 
         -- PA versions of PR functions.
+        , validPA
         , emptyPA
         , nfPA
         , replicatePA
@@ -48,6 +51,14 @@ instance (Eq a, PR a)  => Eq (PArray a) where
  (/=) xs ys = toVectorPA xs /= toVectorPA ys
 
 
+-- | Check that an array has a valid internal representation.
+{-# INLINE_PA validPA #-}
+validPA :: PR a => PArray a -> Bool
+validPA (PArray n darr1)
+        =  validPR darr1
+        && (n == lengthPR darr1)
+
+
 -- | An empty array.
 {-# INLINE_PA emptyPA #-}
 emptyPA :: PR a => PArray a
index 1a93dc3..cad3f1e 100644 (file)
@@ -1,10 +1,13 @@
 {-# LANGUAGE 
+        CPP,
         TypeFamilies, MultiParamTypeClasses,
         FlexibleContexts, ExplicitForAll,
         StandaloneDeriving,
         UndecidableInstances #-}
         -- Undeciable instances only need for derived Show instance
 
+#include "fusion-phases-vseg.h"
+
 module Data.Array.Parallel.PArray.PData.Base 
         ( -- * Parallel Array types.
           PArray(..)
@@ -71,6 +74,10 @@ data family PData a
 
 -- PR Dictionary (Representation) ---------------------------------------------
 class PR a where
+  -- | Check that an array has a well formed representation.
+  --   This should only return False where there is a bug in the library.
+  validPR       :: PData a -> Bool
+
   -- | Produce an empty array with size zero.
   emptyPR      :: PData a
 
index d7436fd..847f969 100644 (file)
@@ -1,5 +1,5 @@
-
 {-# LANGUAGE
+        CPP,
        TypeFamilies,
        FlexibleInstances, FlexibleContexts,
        MultiParamTypeClasses,
@@ -7,9 +7,12 @@
        ExistentialQuantification,
        UndecidableInstances #-}
 
+#include "fusion-phases-vseg.h"
+
 module Data.Array.Parallel.PArray.PData.Nested where
 import Data.Array.Parallel.PArray.PData.Scalar
 import Data.Array.Parallel.PArray.PData.Base
+import Data.Array.Parallel.Base
 
 import qualified Data.Vector                    as V
 import qualified Data.Array.Parallel.Unlifted   as U
@@ -53,8 +56,59 @@ instance (PR a, PprVirtual (PData a)) => PprVirtual (PData (PArray a)) where
 deriving instance Show (PData a) 
         => Show (PData (PArray a))
 
+-- TODO: shift this stuff into dph-base
+validIx  :: String -> Int -> Int -> Bool
+validIx str len ix 
+        = check str len ix (ix >= 0 && ix < len)
+
+validLen :: String -> Int -> Int -> Bool
+validLen str len ix 
+        = checkLen str len ix (ix >= 0 && ix <= len)
+
+-- TODO: slurp debug flag from base 
+validBool :: String -> Bool -> Bool
+validBool str b
+        = if b  then True 
+                else error $ "validBool check failed -- " ++ str
 
 instance PR a => PR (PArray a) where
+
+  -- TODO: ensure that all psegdata arrays are referenced from some psegsrc
+  {-# INLINE_PDATA validPR #-}
+  validPR (PNested vsegids pseglens psegstarts psegsrcs psegdata)
+   = let -- The lengths of the pseglens, psegstarts and psegsrcs fields must all be the same
+         fieldLensOK
+                = validBool "nested field lengths"
+                $ and 
+                [ U.length psegstarts == U.length pseglens
+                , U.length psegsrcs   == U.length pseglens ]
+         
+         -- Each pseg source id must point to a valid flat data array
+         psegsrcsOK
+                = validBool "nested psegsrcs"
+                $ U.and 
+                $ U.map (\srcid -> validIx "nested psegsrcs " (V.length psegdata) srcid)
+                         psegsrcs
+
+         -- Each physical segment must be a valid slice of the corresponding flat array.
+         psegSlicesOK 
+                = validBool "nested pseg slices"
+                $ U.and 
+                $ U.zipWith3 
+                        (\len start srcid
+                           -> let srclen = lengthPR (psegdata V.! srcid)
+                              in  and [ validIx  "nested psegstart " srclen start
+                                      , validLen "nested pseglen   " srclen (start + len)])
+                        pseglens psegstarts psegsrcs
+
+         -- TODO: Check that all psegs are referenced by some vseg.
+         -- TODO: check all vsegs reference a valid pseg.
+
+     in  and [ fieldLensOK
+             , psegsrcsOK
+             , psegSlicesOK]
+                 
+
   {-# INLINE_PDATA emptyPR #-}
   emptyPR
        = PNested
index 88394f3..728d1f8 100644 (file)
@@ -1,9 +1,13 @@
 {-# LANGUAGE
+        CPP,
        TypeFamilies,
        FlexibleInstances, FlexibleContexts,
        MultiParamTypeClasses,
        StandaloneDeriving,
        ExistentialQuantification #-}
+
+#include "fusion-phases-vseg.h"
+
 module Data.Array.Parallel.PArray.PData.Scalar where
 import Data.Array.Parallel.PArray.PData.Base
 import qualified Data.Array.Parallel.Unlifted   as U
@@ -11,6 +15,7 @@ import qualified Data.Vector                    as V
 import Text.PrettyPrint
 
 
+
 data instance PData Int
        = PInt (U.Array Int)
 
@@ -29,6 +34,10 @@ instance PprVirtual (PData Int) where
 
 
 instance PR Int where
+  {-# INLINE_PDATA validPR #-}
+  validPR _
+        = True
+
   {-# INLINE_PDATA emptyPR #-}
   emptyPR
         = PInt U.empty
index ab844e8..c3d9c37 100644 (file)
@@ -18,6 +18,12 @@ Library
         Data.Array.Parallel.PArray.PData.Nested
         Data.Array.Parallel.PArray
 
+  Include-Dirs:
+        include
+
+  Install-Includes:
+        fusion-phases-vseg.h
+
   Extensions:
         TypeFamilies, GADTs, RankNTypes, CPP,
         BangPatterns, MagicHash, UnboxedTuples, TypeOperators
@@ -27,11 +33,6 @@ Library
         -funbox-strict-fields
         -fcpr-off
   
-  CPP-Options:
-        -cpp
-        -DINLINE_PA='INLINE'
-        -DINLINE_PDATA='INLINE'
-
   Build-Depends:  
         base             == 4.4.*,
         ghc              == 7.*,
diff --git a/dph-common-vseg/include/fusion-phases-vseg.h b/dph-common-vseg/include/fusion-phases-vseg.h
new file mode 100644 (file)
index 0000000..44d15bd
--- /dev/null
@@ -0,0 +1,2 @@
+#define INLINE_PDATA INLINE
+#define INLINE_PA    INLINE
\ No newline at end of file