dph-prim-par: break up distributed types module and enable warnings
authorBen Lippmeier <benl@ouroborus.net>
Mon, 29 Aug 2011 07:35:07 +0000 (17:35 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Mon, 29 Aug 2011 07:35:07 +0000 (17:35 +1000)
14 files changed:
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Arrays.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Basics.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Combinators.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/DistST.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Base.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Maybe.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Prim.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Tuple.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/USegd.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Unit.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Vector.hs [new file with mode: 0644]
dph-prim-par/dph-prim-par.cabal

index 8fc7c5c..5b9297e 100644 (file)
@@ -36,12 +36,11 @@ module Data.Array.Parallel.Unlifted.Distributed (
   fromD, toD, debugD
 ) where
 
-import Data.Array.Parallel.Unlifted.Distributed.Gang (
-  Gang, forkGang, gangSize)
 import Data.Array.Parallel.Unlifted.Distributed.TheGang
-import Data.Array.Parallel.Unlifted.Distributed.Types
 import Data.Array.Parallel.Unlifted.Distributed.Combinators
 import Data.Array.Parallel.Unlifted.Distributed.Scalars
 import Data.Array.Parallel.Unlifted.Distributed.Arrays
 import Data.Array.Parallel.Unlifted.Distributed.Basics
+import Data.Array.Parallel.Unlifted.Distributed.Types
+import Data.Array.Parallel.Unlifted.Distributed.Gang (Gang, forkGang, gangSize)
 
index fcd3942..4004cd1 100644 (file)
@@ -15,18 +15,12 @@ module Data.Array.Parallel.Unlifted.Distributed.Arrays (
 import Data.Array.Parallel.Base ( ST, runST)
 import Data.Array.Parallel.Unlifted.Sequential.Vector as Seq
 import Data.Array.Parallel.Unlifted.Sequential.Segmented
-import Data.Array.Parallel.Unlifted.Distributed.Gang (
-  Gang, gangSize, seqGang)
-import Data.Array.Parallel.Unlifted.Distributed.DistST (
-  DistST, stToDistST, myIndex )
-import Data.Array.Parallel.Unlifted.Distributed.Types (
-  DT, Dist, mkDPrim, indexD, lengthD, newD, writeMD, zipD, unzipD, fstD, sndD,
-  elementsUSegdD,
-  checkGangD)
+import Data.Array.Parallel.Unlifted.Distributed.Gang
+import Data.Array.Parallel.Unlifted.Distributed.DistST
+import Data.Array.Parallel.Unlifted.Distributed.Types
 import Data.Array.Parallel.Unlifted.Distributed.Basics
 import Data.Array.Parallel.Unlifted.Distributed.Combinators
-import Data.Array.Parallel.Unlifted.Distributed.Scalars (
-  sumD)
+import Data.Array.Parallel.Unlifted.Distributed.Scalars
 
 import Data.Bits ( shiftR )
 import Control.Monad ( when )
index 39c2c9f..4d2a4cd 100644 (file)
@@ -2,15 +2,10 @@
 module Data.Array.Parallel.Unlifted.Distributed.Basics (
   eqD, neqD, toD, fromD
 ) where
-import Data.Array.Parallel.Unlifted.Distributed.Gang (
-  Gang, gangSize)
-import Data.Array.Parallel.Unlifted.Distributed.Types (
-  DT, Dist, indexD, newD, writeMD,
-  checkGangD)
-import Data.Array.Parallel.Unlifted.Distributed.Combinators (
-  zipWithD)
-import Data.Array.Parallel.Unlifted.Distributed.Scalars (
-  andD, orD)
+import Data.Array.Parallel.Unlifted.Distributed.Gang 
+import Data.Array.Parallel.Unlifted.Distributed.Types
+import Data.Array.Parallel.Unlifted.Distributed.Combinators 
+import Data.Array.Parallel.Unlifted.Distributed.Scalars
 import Control.Monad ( zipWithM_ )
 
 
index 733b576..5787ad5 100644 (file)
@@ -12,12 +12,8 @@ module Data.Array.Parallel.Unlifted.Distributed.Combinators (
   mapDST_, mapDST, zipWithDST_, zipWithDST
 ) where
 import Data.Array.Parallel.Base ( ST, runST)
-import Data.Array.Parallel.Unlifted.Distributed.Gang (
-  Gang, gangSize)
-import Data.Array.Parallel.Unlifted.Distributed.Types (
-  DT, Dist, MDist, indexD, zipD, unzipD, fstD, sndD, deepSeqD,
-  newMD, writeMD, unsafeFreezeMD,
-  checkGangD, measureD, debugD)
+import Data.Array.Parallel.Unlifted.Distributed.Gang
+import Data.Array.Parallel.Unlifted.Distributed.Types
 import Data.Array.Parallel.Unlifted.Distributed.DistST
 import Debug.Trace
 
index ddd3b6e..58a6c92 100644 (file)
@@ -11,11 +11,9 @@ module Data.Array.Parallel.Unlifted.Distributed.DistST (
   DistST, stToDistST, distST_, distST, runDistST, runDistST_seq, traceDistST,
   myIndex, myD, readMyMD, writeMyMD
 ) where
-import Data.Array.Parallel.Base (
-  ST, runST)
+import Data.Array.Parallel.Base (ST, runST)
 import Data.Array.Parallel.Unlifted.Distributed.Gang
-import Data.Array.Parallel.Unlifted.Distributed.Types (
-  DT(..), Dist, MDist)
+import Data.Array.Parallel.Unlifted.Distributed.Types (DT(..), Dist, MDist)
 
 import Control.Monad (liftM)
 
index 16738c0..b40f2e5 100644 (file)
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
 {-# LANGUAGE CPP #-}
 
 #include "fusion-phases.h"
 
 -- | Distributed types.
 module Data.Array.Parallel.Unlifted.Distributed.Types (
-  -- * Distributed types
-  DT, Dist, MDist, DPrim(..),
-
-  -- * Operations on immutable distributed types
-  indexD, unitD, 
-  zipD,  unzipD, fstD, sndD, 
-  zip3D, unzip3D, 
-  lengthD,
-  newD,
-  -- zipSD, unzipSD, fstSD, sndSD,
-  deepSeqD,
-
-  lengthUSegdD, lengthsUSegdD, indicesUSegdD, elementsUSegdD,
-
-  -- * Operations on mutable distributed types
-  newMD, readMD, writeMD, unsafeFreezeMD,
-
-  -- * Assertions
-  checkGangD, checkGangMD,
-
-  -- * Debugging functions
-  sizeD, sizeMD, measureD, debugD
+        module Data.Array.Parallel.Unlifted.Distributed.Types.USegd,
+        module Data.Array.Parallel.Unlifted.Distributed.Types.Vector,
+        module Data.Array.Parallel.Unlifted.Distributed.Types.Maybe,
+        module Data.Array.Parallel.Unlifted.Distributed.Types.Tuple,
+        module Data.Array.Parallel.Unlifted.Distributed.Types.Prim,
+        module Data.Array.Parallel.Unlifted.Distributed.Types.Unit,
+        module Data.Array.Parallel.Unlifted.Distributed.Types.Base
 ) where
+import Data.Array.Parallel.Unlifted.Distributed.Types.USegd
+import Data.Array.Parallel.Unlifted.Distributed.Types.Vector
+import Data.Array.Parallel.Unlifted.Distributed.Types.Maybe
+import Data.Array.Parallel.Unlifted.Distributed.Types.Tuple
+import Data.Array.Parallel.Unlifted.Distributed.Types.Prim
+import Data.Array.Parallel.Unlifted.Distributed.Types.Unit
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
 
-import Data.Array.Parallel.Unlifted.Distributed.Gang (
-  Gang, gangSize )
-import Data.Array.Parallel.Unlifted.Sequential.Vector ( Unbox, Vector )
-import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V
-import Data.Array.Parallel.Unlifted.Sequential.Segmented
-import Data.Array.Parallel.Base
-
-import qualified Data.Vector.Unboxed as V
-import qualified Data.Vector.Unboxed.Mutable as MV
-import qualified Data.Vector as BV
-import qualified Data.Vector.Mutable as MBV
-
-import Data.Word     (Word8)
-import Control.Monad (liftM, liftM2, liftM3)
-
-import Data.List ( intercalate )
-
-infixl 9 `indexD`
-
-here s = "Data.Array.Parallel.Unlifted.Distributed.Types." ++ s
-
-
--- Distributed Types ----------------------------------------------------------
--- | Class of distributable types. Instances of 'DT' can be
---   distributed across all workers of a 'Gang'. 
---   All such types must be hyperstrict as we do not want to pass thunks
---   into distributed computations.
-class DT a where
-  data Dist  a
-  data MDist a :: * -> *
-
-  -- | Extract a single element of an immutable distributed value.
-  indexD         :: Dist a -> Int -> a
-
-  -- | Create an unitialised distributed value for the given 'Gang'.
-  --   The gang is used (only) to know how many elements are needed
-  --   in the distributed value.
-  newMD          :: Gang                  -> ST s (MDist a s)
-
-  -- | Extract an element from a mutable distributed value.
-  readMD         :: MDist a s -> Int      -> ST s a
-
-  -- | Write an element of a mutable distributed value.
-  writeMD        :: MDist a s -> Int -> a -> ST s ()
-
-  -- | Unsafely freeze a mutable distributed value.
-  unsafeFreezeMD :: MDist a s             -> ST s (Dist a)
-
-  deepSeqD       :: a -> b -> b
-  deepSeqD = seq
-
-
-  -- Debugging ------------------------
-  -- | Number of elements in the distributed value.
-  --   For debugging only, as we shouldn't depend on the size of the gang.
-  sizeD :: Dist a -> Int
-
-  -- | Number of elements in the mutable distributed value.
-  --   For debugging only, as we shouldn't care about the actual number.
-  sizeMD :: MDist a s -> Int
-
-  -- | Show a distributed value.
-  --   For debugging only.
-  measureD :: a -> String
-  measureD _ = "None"
-
--- Show instance (for debugging only)
-instance (Show a, DT a) => Show (Dist a) where
-  show d = show (Prelude.map (indexD d) [0 .. sizeD d - 1])
-
-
-
--- Checking -------------------------------------------------------------------
--- | Check that the sizes of the 'Gang' and of the distributed value match.
-checkGangD :: DT a => String -> Gang -> Dist a -> b -> b
-checkGangD loc g d v = checkEq loc "Wrong gang" (gangSize g) (sizeD d) v
-
-
--- | Check that the sizes of the 'Gang' and of the mutable distributed value match.
-checkGangMD :: DT a => String -> Gang -> MDist a s -> b -> b
-checkGangMD loc g d v = checkEq loc "Wrong gang" (gangSize g) (sizeMD d) v
-
-
--- Operations -----------------------------------------------------------------
--- | Given a computation that can write its result to a mutable distributed value, 
---   run the computation to generate an immutable distributed value.
-newD :: DT a => Gang -> (forall s . MDist a s -> ST s ()) -> Dist a
-newD g init =
-  runST (do
-           mdt <- newMD g
-           init mdt
-           unsafeFreezeMD mdt)
-
--- | Show all members of a distributed value.
-debugD :: DT a => Dist a -> String
-debugD d = "["
-         ++ intercalate "," [measureD (indexD d i) | i <- [0 .. sizeD d-1]]
-         ++ "]"
-
-
--- DPrim ----------------------------------------------------------------------
--- | For distributed primitive values, we can just store all the members in
---   a vector. The vector has the same length as the number of threads in the gang.
---
-class Unbox e => DPrim e where
-
-  -- | Make an immutable distributed value.
-  mkDPrim :: V.Vector e -> Dist  e
-
-  -- | Unpack an immutable distributed value back into a vector.
-  unDPrim :: Dist  e -> V.Vector e
-
-  -- | Make a mutable distributed value.
-  mkMDPrim :: MV.STVector s e -> MDist  e s
-
-  -- | Unpack a mutable distributed value back into a vector.
-  unMDPrim :: MDist  e s -> MV.STVector s e
-
-
--- | Get the member corresponding to a thread index.
-primIndexD :: DPrim a => Dist a -> Int -> a
-{-# INLINE primIndexD #-}
-primIndexD = (V.!) . unDPrim
-
-
--- | Create a new distributed value, having as many members as threads
---   in the given 'Gang'.
-primNewMD :: DPrim a => Gang -> ST s (MDist a s)
-{-# INLINE primNewMD #-}
-primNewMD = liftM mkMDPrim . MV.new . gangSize
-
-
--- | Read the member of a distributed value corresponding to the given thread index.
-primReadMD :: DPrim a => MDist a s -> Int -> ST s a
-{-# INLINE primReadMD #-}
-primReadMD = MV.read . unMDPrim
-
-
--- | Write the member of a distributed value corresponding to the given thread index.
-primWriteMD :: DPrim a => MDist a s -> Int -> a -> ST s ()
-{-# INLINE primWriteMD #-}
-primWriteMD = MV.write . unMDPrim
-
-
--- | Freeze a mutable distributed value to an immutable one.
---   You promise not to update the mutable one any further.
-primUnsafeFreezeMD :: DPrim a => MDist a s -> ST s (Dist a)
-{-# INLINE primUnsafeFreezeMD #-}
-primUnsafeFreezeMD = liftM mkDPrim . V.unsafeFreeze . unMDPrim
-
-
--- | Get the size of a distributed value, that is, the number of threads
---   in the gang that it was created for.
-primSizeD :: DPrim a => Dist a -> Int
-{-# INLINE primSizeD #-}
-primSizeD = V.length . unDPrim
-
-
--- | Get the size of a distributed mutable value, that is, the number of threads
---   in the gang it was created for.
-primSizeMD :: DPrim a => MDist a s -> Int
-{-# INLINE primSizeMD #-}
-primSizeMD = MV.length . unMDPrim
-
-
--- Unit -----------------------------------------------------------------------
-instance DT () where
-  data Dist ()    = DUnit  !Int
-  data MDist () s = MDUnit !Int
-
-  indexD  (DUnit n) i       = check (here "indexD[()]") n i $ ()
-  newMD                     = return . MDUnit . gangSize
-  readMD   (MDUnit n) i     = check (here "readMD[()]")  n i $
-                               return ()
-  writeMD  (MDUnit n) i ()  = check (here "writeMD[()]") n i $
-                               return ()
-  unsafeFreezeMD (MDUnit n) = return $ DUnit n
-
-  sizeD  = error "dph-prim-par:sizeD[()] undefined"
-  sizeMD = error "dph-prim-par:sizeMD[()] undefined"
-
--- | Yield a distributed unit.
-unitD :: Gang -> Dist ()
-{-# INLINE_DIST unitD #-}
-unitD = DUnit . gangSize
-
-
--- Bool -----------------------------------------------------------------------
-instance DPrim Bool where
-  mkDPrim           = DBool
-  unDPrim (DBool a) = a
-
-  mkMDPrim            = MDBool
-  unMDPrim (MDBool a) = a
-
-instance DT Bool where
-  data Dist  Bool   = DBool  !(V.Vector    Bool)
-  data MDist Bool s = MDBool !(MV.STVector s Bool)
-
-  indexD         = primIndexD
-  newMD          = primNewMD
-  readMD         = primReadMD
-  writeMD        = primWriteMD
-  unsafeFreezeMD = primUnsafeFreezeMD
-  sizeD          = primSizeD
-  sizeMD         = primSizeMD
-
-
--- Char -----------------------------------------------------------------------
-instance DPrim Char where
-  mkDPrim           = DChar
-  unDPrim (DChar a) = a
-
-  mkMDPrim            = MDChar
-  unMDPrim (MDChar a) = a
-
-instance DT Char where
-  data Dist  Char   = DChar  !(V.Vector    Char)
-  data MDist Char s = MDChar !(MV.STVector s Char)
-
-  indexD         = primIndexD
-  newMD          = primNewMD
-  readMD         = primReadMD
-  writeMD        = primWriteMD
-  unsafeFreezeMD = primUnsafeFreezeMD
-  sizeD          = primSizeD
-  sizeMD         = primSizeMD
-
-
--- Int ------------------------------------------------------------------------
-instance DPrim Int where
-  mkDPrim          = DInt
-  unDPrim (DInt a) = a
-
-  mkMDPrim            = MDInt
-  unMDPrim (MDInt a) = a
-
-instance DT Int where
-  data Dist  Int   = DInt  !(V.Vector    Int)
-  data MDist Int s = MDInt !(MV.STVector s Int)
-
-  indexD         = primIndexD
-  newMD          = primNewMD
-  readMD         = primReadMD
-  writeMD        = primWriteMD
-  unsafeFreezeMD = primUnsafeFreezeMD
-  sizeD          = primSizeD
-  sizeMD         = primSizeMD
-
-  measureD n = "Int " ++ show n
-
-
--- Word8 ----------------------------------------------------------------------
-instance DPrim Word8 where
-  mkDPrim            = DWord8
-  unDPrim (DWord8 a) = a
-
-  mkMDPrim             = MDWord8
-  unMDPrim (MDWord8 a) = a
-
-instance DT Word8 where
-  data Dist  Word8   = DWord8  !(V.Vector    Word8)
-  data MDist Word8 s = MDWord8 !(MV.STVector s Word8)
-
-  indexD         = primIndexD
-  newMD          = primNewMD
-  readMD         = primReadMD
-  writeMD        = primWriteMD
-  unsafeFreezeMD = primUnsafeFreezeMD
-  sizeD          = primSizeD
-  sizeMD         = primSizeMD
-
-
--- Float ----------------------------------------------------------------------
-instance DPrim Float where
-  mkDPrim            = DFloat
-  unDPrim (DFloat a) = a
-
-  mkMDPrim             = MDFloat
-  unMDPrim (MDFloat a) = a
-
-instance DT Float where
-  data Dist  Float   = DFloat  !(V.Vector    Float)
-  data MDist Float s = MDFloat !(MV.STVector s Float)
-
-  indexD         = primIndexD
-  newMD          = primNewMD
-  readMD         = primReadMD
-  writeMD        = primWriteMD
-  unsafeFreezeMD = primUnsafeFreezeMD
-  sizeD          = primSizeD
-  sizeMD         = primSizeMD
-
-
--- Double ---------------------------------------------------------------------
-instance DPrim Double where
-  mkDPrim             = DDouble
-  unDPrim (DDouble a) = a
-
-  mkMDPrim              = MDDouble
-  unMDPrim (MDDouble a) = a
-
-instance DT Double where
-  data Dist  Double   = DDouble  !(V.Vector    Double)
-  data MDist Double s = MDDouble !(MV.STVector s Double)
-
-  indexD         = primIndexD
-  newMD          = primNewMD
-  readMD         = primReadMD
-  writeMD        = primWriteMD
-  unsafeFreezeMD = primUnsafeFreezeMD
-  sizeD          = primSizeD
-  sizeMD         = primSizeMD
-
-
--- Pairs ----------------------------------------------------------------------
-instance (DT a, DT b) => DT (a,b) where
-  data Dist  (a,b)   = DProd  !(Dist a)    !(Dist b)
-  data MDist (a,b) s = MDProd !(MDist a s) !(MDist b s)
-
-  indexD d i               = (fstD d `indexD` i,sndD d `indexD` i)
-  newMD g                  = liftM2 MDProd (newMD g) (newMD g)
-  readMD  (MDProd xs ys) i = liftM2 (,) (readMD xs i) (readMD ys i)
-  writeMD (MDProd xs ys) i (x,y)
-                            = writeMD xs i x >> writeMD ys i y
-  unsafeFreezeMD (MDProd xs ys)
-                            = liftM2 DProd (unsafeFreezeMD xs)
-                                           (unsafeFreezeMD ys)
-
-  {-# INLINE deepSeqD #-}
-  deepSeqD (x,y) z = deepSeqD x (deepSeqD y z)
-
-  sizeD  (DProd  x _) = sizeD  x
-  sizeMD (MDProd x _) = sizeMD x
-
-  measureD (x,y) = "Pair " ++ "(" ++ measureD x ++ ") (" ++  measureD y ++ ")"
-
-
--- | Pairing of distributed values.
--- /The two values must belong to the same/ 'Gang'.
-zipD :: (DT a, DT b) => Dist a -> Dist b -> Dist (a,b)
-{-# INLINE [0] zipD #-}
-zipD !x !y = checkEq (here "zipDT") "Size mismatch" (sizeD x) (sizeD y) $
-             DProd x y
-
--- | Unpairing of distributed values.
-unzipD :: (DT a, DT b) => Dist (a,b) -> (Dist a, Dist b)
-{-# INLINE_DIST unzipD #-}
-unzipD (DProd dx dy) = (dx,dy)
-
--- | Extract the first elements of a distributed pair.
-fstD :: (DT a, DT b) => Dist (a,b) -> Dist a
-{-# INLINE_DIST fstD #-}
-fstD = fst . unzipD
-
--- | Extract the second elements of a distributed pair.
-sndD :: (DT a, DT b) => Dist (a,b) -> Dist b
-{-# INLINE_DIST sndD #-}
-sndD = snd . unzipD
-
-
--- Triples --------------------------------------------------------------------
-instance (DT a, DT b, DT c) => DT (a,b,c) where
-  data Dist  (a,b,c)   = DProd3  !(Dist a)    !(Dist b)    !(Dist c)
-  data MDist (a,b,c) s = MDProd3 !(MDist a s) !(MDist b s) !(MDist c s)
-
-  indexD (DProd3 xs ys zs) i
-   = ( xs `indexD` i
-     , ys `indexD` i
-     , zs `indexD` i)
-
-  newMD g
-   = liftM3 MDProd3 (newMD g) (newMD g) (newMD g)
-
-  readMD  (MDProd3 xs ys zs) i
-   = liftM3 (,,) (readMD xs i) (readMD ys i) (readMD zs i)
-
-  writeMD (MDProd3 xs ys zs) i (x,y,z)
-   =  writeMD xs i x
-   >> writeMD ys i y
-   >> writeMD zs i z
-
-  unsafeFreezeMD (MDProd3 xs ys zs)
-   = liftM3 DProd3 (unsafeFreezeMD xs) (unsafeFreezeMD ys) (unsafeFreezeMD zs)
-
-  {-# INLINE deepSeqD #-}
-  deepSeqD (x,y,z) k 
-   = deepSeqD x (deepSeqD y (deepSeqD z k))
-
-  sizeD  (DProd3  x _ _) = sizeD  x
-  sizeMD (MDProd3 x _ _) = sizeMD x
-
-  measureD (x,y,z)
-   = "Triple " 
-        ++ "(" ++ measureD x ++ ") "
-        ++ "(" ++ measureD y ++ ") "
-        ++ "(" ++ measureD z ++ ")"
-
-
--- | Pairing of distributed values.
--- /The two values must belong to the same/ 'Gang'.
-zip3D   :: (DT a, DT b, DT c) => Dist a -> Dist b -> Dist c -> Dist (a,b,c)
-{-# INLINE [0] zip3D #-}
-zip3D !x !y !z
-        = checkEq (here "zip3DT") "Size mismatch" (sizeD x) (sizeD y) 
-        $ checkEq (here "zip3DT") "Size mismatch" (sizeD x) (sizeD z) 
-        $ DProd3 x y z
-
-
--- | Unpairing of distributed values.
-unzip3D  :: (DT a, DT b, DT c) => Dist (a,b,c) -> (Dist a, Dist b, Dist c)
-{-# INLINE_DIST unzip3D #-}
-unzip3D (DProd3 dx dy dz) = (dx,dy,dz)
-
-
--- Maybe ----------------------------------------------------------------------
-instance DT a => DT (Maybe a) where
-  data Dist  (Maybe a)   = DMaybe  !(Dist  Bool)   !(Dist  a)
-  data MDist (Maybe a) s = MDMaybe !(MDist Bool s) !(MDist a s)
-
-  indexD (DMaybe bs as) i
-    | bs `indexD` i       = Just $ as `indexD` i
-    | otherwise           = Nothing
-  newMD g = liftM2 MDMaybe (newMD g) (newMD g)
-  readMD (MDMaybe bs as) i =
-    do
-      b <- readMD bs i
-      if b then liftM Just $ readMD as i
-           else return Nothing
-  writeMD (MDMaybe bs as) i Nothing  = writeMD bs i False
-  writeMD (MDMaybe bs as) i (Just x) = writeMD bs i True
-                                     >> writeMD as i x
-  unsafeFreezeMD (MDMaybe bs as) = liftM2 DMaybe (unsafeFreezeMD bs)
-                                                 (unsafeFreezeMD as)
-
-  {-# INLINE deepSeqD #-}
-  deepSeqD Nothing  z = z
-  deepSeqD (Just x) z = deepSeqD x z
-
-  sizeD  (DMaybe  b _) = sizeD  b
-  sizeMD (MDMaybe b _) = sizeMD b
-
-  measureD Nothing = "Nothing"
-  measureD (Just x) = "Just (" ++ measureD x ++ ")"
-
-
--- Vector ---------------------------------------------------------------------
-instance Unbox a => DT (V.Vector a) where
-  data Dist  (Vector a)   = DVector  !(Dist  Int)   !(BV.Vector      (Vector a))
-  data MDist (Vector a) s = MDVector !(MDist Int s) !(MBV.STVector s (Vector a))
-
-  indexD (DVector _ a) i = a BV.! i
-  newMD g = liftM2 MDVector (newMD g) (MBV.replicate (gangSize g)
-                                         (error "MDist (Vector a) - uninitalised"))
-  readMD (MDVector _ marr) = MBV.read marr
-  writeMD (MDVector mlen marr) i a =
-    do
-      writeMD mlen i (V.length a)
-      MBV.write marr i $! a
-  unsafeFreezeMD (MDVector len a) = liftM2 DVector (unsafeFreezeMD len)
-                                               (BV.unsafeFreeze a)
-  sizeD  (DVector  _ a) = BV.length  a
-  sizeMD (MDVector _ a) = MBV.length a
-
-  measureD xs = "Vector " ++ show (V.length xs)
-
-
--- | Yield the distributed length of a distributed array.
-lengthD :: Unbox a => Dist (Vector a) -> Dist Int
-lengthD (DVector l _) = l
-
-
--- USegd ----------------------------------------------------------------------
-instance DT USegd where
-  data Dist  USegd   = DUSegd  !(Dist (Vector Int))
-                               !(Dist (Vector Int))
-                               !(Dist Int)
-
-  data MDist USegd s = MDUSegd !(MDist (Vector Int) s)
-                               !(MDist (Vector Int) s)
-                               !(MDist Int        s)
-
-  indexD (DUSegd lens idxs eles) i
-   = mkUSegd (indexD lens i) (indexD idxs i) (indexD eles i)
-
-  newMD g
-   = liftM3 MDUSegd (newMD g) (newMD g) (newMD g)
-
-  readMD (MDUSegd lens idxs eles) i
-   = liftM3 mkUSegd (readMD lens i) (readMD idxs i) (readMD eles i)
-
-  writeMD (MDUSegd lens idxs eles) i segd
-   = do writeMD lens i (lengthsUSegd  segd)
-        writeMD idxs i (indicesUSegd  segd)
-        writeMD eles i (elementsUSegd segd)
-
-  unsafeFreezeMD (MDUSegd lens idxs eles)
-   = liftM3 DUSegd (unsafeFreezeMD lens)
-                   (unsafeFreezeMD idxs)
-                   (unsafeFreezeMD eles)
-
-  deepSeqD segd z
-   = deepSeqD (lengthsUSegd  segd)
-   $ deepSeqD (indicesUSegd  segd)
-   $ deepSeqD (elementsUSegd segd) z
-
-  sizeD  (DUSegd  _ _ eles) = sizeD eles
-  sizeMD (MDUSegd _ _ eles) = sizeMD eles
-
-  measureD segd 
-   = "Segd " ++ show (lengthUSegd segd) ++ " " ++ show (elementsUSegd segd)
-
-
-lengthUSegdD :: Dist USegd -> Dist Int
-{-# INLINE_DIST lengthUSegdD #-}
-lengthUSegdD (DUSegd lens _ _) = lengthD lens
-
-
-lengthsUSegdD :: Dist USegd -> Dist (Vector Int)
-{-# INLINE_DIST lengthsUSegdD #-}
-lengthsUSegdD (DUSegd lens _ _ ) = lens
-
-
-indicesUSegdD :: Dist USegd -> Dist (Vector Int)
-{-# INLINE_DIST indicesUSegdD #-}
-indicesUSegdD (DUSegd _ idxs _) = idxs
-
-
-elementsUSegdD :: Dist USegd -> Dist Int
-{-# INLINE_DIST elementsUSegdD #-}
-elementsUSegdD (DUSegd _ _ dns) = dns
 
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Base.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Base.hs
new file mode 100644 (file)
index 0000000..f7106ad
--- /dev/null
@@ -0,0 +1,99 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+module Data.Array.Parallel.Unlifted.Distributed.Types.Base (
+  -- * Distributable Types
+  DT(..),
+
+  -- * Checking
+  checkGangD,
+  checkGangMD,
+  
+  -- * General Operations
+  newD, 
+  debugD
+)
+where
+import Data.Array.Parallel.Unlifted.Distributed.Gang    (Gang, gangSize)
+import Data.Array.Parallel.Base
+import Data.List                                        (intercalate)
+
+
+-- Distributed Types ----------------------------------------------------------
+infixl 9 `indexD`
+
+-- | Class of distributable types. Instances of 'DT' can be
+--   distributed across all workers of a 'Gang'. 
+--   All such types must be hyperstrict as we do not want to pass thunks
+--   into distributed computations.
+class DT a where
+  data Dist  a
+  data MDist a :: * -> *
+
+  -- | Extract a single element of an immutable distributed value.
+  indexD         :: Dist a -> Int -> a
+
+  -- | Create an unitialised distributed value for the given 'Gang'.
+  --   The gang is used (only) to know how many elements are needed
+  --   in the distributed value.
+  newMD          :: Gang                  -> ST s (MDist a s)
+
+  -- | Extract an element from a mutable distributed value.
+  readMD         :: MDist a s -> Int      -> ST s a
+
+  -- | Write an element of a mutable distributed value.
+  writeMD        :: MDist a s -> Int -> a -> ST s ()
+
+  -- | Unsafely freeze a mutable distributed value.
+  unsafeFreezeMD :: MDist a s             -> ST s (Dist a)
+
+  deepSeqD       :: a -> b -> b
+  deepSeqD = seq
+
+
+  -- Debugging ------------------------
+  -- | Number of elements in the distributed value.
+  --   For debugging only, as we shouldn't depend on the size of the gang.
+  sizeD :: Dist a -> Int
+
+  -- | Number of elements in the mutable distributed value.
+  --   For debugging only, as we shouldn't care about the actual number.
+  sizeMD :: MDist a s -> Int
+
+  -- | Show a distributed value.
+  --   For debugging only.
+  measureD :: a -> String
+  measureD _ = "None"
+
+
+-- Show -----------------------------------------------------------------------
+-- Show instance (for debugging only) --
+instance (Show a, DT a) => Show (Dist a) where
+  show d = show (Prelude.map (indexD d) [0 .. sizeD d - 1])
+
+
+-- Checking -------------------------------------------------------------------
+-- | Check that the sizes of the 'Gang' and of the distributed value match.
+checkGangD :: DT a => String -> Gang -> Dist a -> b -> b
+checkGangD loc g d v = checkEq loc "Wrong gang" (gangSize g) (sizeD d) v
+
+
+-- | Check that the sizes of the 'Gang' and of the mutable distributed value match.
+checkGangMD :: DT a => String -> Gang -> MDist a s -> b -> b
+checkGangMD loc g d v = checkEq loc "Wrong gang" (gangSize g) (sizeMD d) v
+
+
+-- Operations -----------------------------------------------------------------
+-- | Given a computation that can write its result to a mutable distributed value, 
+--   run the computation to generate an immutable distributed value.
+newD :: DT a => Gang -> (forall s . MDist a s -> ST s ()) -> Dist a
+newD g mkInit =
+  runST (do
+           mdt <- newMD g
+           mkInit mdt
+           unsafeFreezeMD mdt)
+
+-- | Show all members of a distributed value.
+debugD :: DT a => Dist a -> String
+debugD d = "["
+         ++ intercalate "," [measureD (indexD d i) | i <- [0 .. sizeD d-1]]
+         ++ "]"
+
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Maybe.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Maybe.hs
new file mode 100644 (file)
index 0000000..4f80231
--- /dev/null
@@ -0,0 +1,45 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+
+-- Distribution of Maybes
+module Data.Array.Parallel.Unlifted.Distributed.Types.Maybe where
+import Data.Array.Parallel.Unlifted.Distributed.Types.Prim      ()
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Control.Monad
+
+
+instance DT a => DT (Maybe a) where
+  data Dist  (Maybe a)   = DMaybe  !(Dist  Bool)   !(Dist  a)
+  data MDist (Maybe a) s = MDMaybe !(MDist Bool s) !(MDist a s)
+
+  indexD (DMaybe bs as) i
+    | bs `indexD` i       = Just $ as `indexD` i
+    | otherwise           = Nothing
+
+  newMD g
+   = liftM2 MDMaybe (newMD g) (newMD g)
+
+  readMD (MDMaybe bs as) i 
+   = do b <- readMD bs i
+        if b then liftM Just $ readMD as i
+             else return Nothing
+
+  writeMD (MDMaybe bs _) i Nothing 
+   = writeMD bs i False
+
+  writeMD (MDMaybe bs as) i (Just x)
+   = do writeMD bs i True
+        writeMD as i x
+
+  unsafeFreezeMD (MDMaybe bs as)
+   = liftM2 DMaybe (unsafeFreezeMD bs)
+                   (unsafeFreezeMD as)
+
+  {-# INLINE deepSeqD #-}
+  deepSeqD Nothing  z   = z
+  deepSeqD (Just x) z   = deepSeqD x z
+
+  sizeD  (DMaybe  b _)  = sizeD  b
+  sizeMD (MDMaybe b _)  = sizeMD b
+
+  measureD Nothing      = "Nothing"
+  measureD (Just x)     = "Just (" ++ measureD x ++ ")"
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Prim.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Prim.hs
new file mode 100644 (file)
index 0000000..ae01f93
--- /dev/null
@@ -0,0 +1,216 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+
+-- | Distribution of values of primitive types.
+module Data.Array.Parallel.Unlifted.Distributed.Types.Prim (
+        DPrim(..)
+) where
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Data.Array.Parallel.Unlifted.Distributed.Gang
+import Data.Array.Parallel.Unlifted.Sequential.Vector
+import Data.Array.Parallel.Base
+import Data.Word
+import Control.Monad
+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V
+import qualified Data.Vector.Unboxed.Mutable                    as MV
+import Prelude as P
+
+-- DPrim ----------------------------------------------------------------------
+-- | For distributed primitive values, we can just store all the members in
+--   a vector. The vector has the same length as the number of threads in the gang.
+--
+class Unbox e => DPrim e where
+
+  -- | Make an immutable distributed value.
+  mkDPrim :: V.Vector e -> Dist  e
+
+  -- | Unpack an immutable distributed value back into a vector.
+  unDPrim :: Dist  e -> V.Vector e
+
+  -- | Make a mutable distributed value.
+  mkMDPrim :: MV.STVector s e -> MDist  e s
+
+  -- | Unpack a mutable distributed value back into a vector.
+  unMDPrim :: MDist  e s -> MV.STVector s e
+
+
+-- | Get the member corresponding to a thread index.
+primIndexD :: DPrim a => Dist a -> Int -> a
+{-# INLINE primIndexD #-}
+primIndexD = (V.!) . unDPrim
+
+
+-- | Create a new distributed value, having as many members as threads
+--   in the given 'Gang'.
+primNewMD :: DPrim a => Gang -> ST s (MDist a s)
+{-# INLINE primNewMD #-}
+primNewMD = liftM mkMDPrim . MV.new . gangSize
+
+
+-- | Read the member of a distributed value corresponding to the given thread index.
+primReadMD :: DPrim a => MDist a s -> Int -> ST s a
+{-# INLINE primReadMD #-}
+primReadMD = MV.read . unMDPrim
+
+
+-- | Write the member of a distributed value corresponding to the given thread index.
+primWriteMD :: DPrim a => MDist a s -> Int -> a -> ST s ()
+{-# INLINE primWriteMD #-}
+primWriteMD = MV.write . unMDPrim
+
+
+-- | Freeze a mutable distributed value to an immutable one.
+--   You promise not to update the mutable one any further.
+primUnsafeFreezeMD :: DPrim a => MDist a s -> ST s (Dist a)
+{-# INLINE primUnsafeFreezeMD #-}
+primUnsafeFreezeMD = liftM mkDPrim . V.unsafeFreeze . unMDPrim
+
+
+-- | Get the size of a distributed value, that is, the number of threads
+--   in the gang that it was created for.
+primSizeD :: DPrim a => Dist a -> Int
+{-# INLINE primSizeD #-}
+primSizeD = V.length . unDPrim
+
+
+-- | Get the size of a distributed mutable value, that is, the number of threads
+--   in the gang it was created for.
+primSizeMD :: DPrim a => MDist a s -> Int
+{-# INLINE primSizeMD #-}
+primSizeMD = MV.length . unMDPrim
+
+
+
+-- Bool -----------------------------------------------------------------------
+instance DPrim Bool where
+  mkDPrim           = DBool
+  unDPrim (DBool a) = a
+
+  mkMDPrim            = MDBool
+  unMDPrim (MDBool a) = a
+
+
+instance DT Bool where
+  data Dist  Bool   = DBool  !(V.Vector    Bool)
+  data MDist Bool s = MDBool !(MV.STVector s Bool)
+
+  indexD         = primIndexD
+  newMD          = primNewMD
+  readMD         = primReadMD
+  writeMD        = primWriteMD
+  unsafeFreezeMD = primUnsafeFreezeMD
+  sizeD          = primSizeD
+  sizeMD         = primSizeMD
+
+
+-- Char -----------------------------------------------------------------------
+instance DPrim Char where
+  mkDPrim           = DChar
+  unDPrim (DChar a) = a
+
+  mkMDPrim            = MDChar
+  unMDPrim (MDChar a) = a
+
+
+instance DT Char where
+  data Dist  Char   = DChar  !(V.Vector    Char)
+  data MDist Char s = MDChar !(MV.STVector s Char)
+
+  indexD         = primIndexD
+  newMD          = primNewMD
+  readMD         = primReadMD
+  writeMD        = primWriteMD
+  unsafeFreezeMD = primUnsafeFreezeMD
+  sizeD          = primSizeD
+  sizeMD         = primSizeMD
+
+
+-- Int ------------------------------------------------------------------------
+instance DPrim Int where
+  mkDPrim          = DInt
+  unDPrim (DInt a) = a
+
+  mkMDPrim            = MDInt
+  unMDPrim (MDInt a) = a
+
+
+instance DT Int where
+  data Dist  Int   = DInt  !(V.Vector    Int)
+  data MDist Int s = MDInt !(MV.STVector s Int)
+
+  indexD         = primIndexD
+  newMD          = primNewMD
+  readMD         = primReadMD
+  writeMD        = primWriteMD
+  unsafeFreezeMD = primUnsafeFreezeMD
+  sizeD          = primSizeD
+  sizeMD         = primSizeMD
+
+  measureD n = "Int " P.++ show n
+
+
+-- Word8 ----------------------------------------------------------------------
+instance DPrim Word8 where
+  mkDPrim            = DWord8
+  unDPrim (DWord8 a) = a
+
+  mkMDPrim             = MDWord8
+  unMDPrim (MDWord8 a) = a
+
+
+instance DT Word8 where
+  data Dist  Word8   = DWord8  !(V.Vector    Word8)
+  data MDist Word8 s = MDWord8 !(MV.STVector s Word8)
+
+  indexD         = primIndexD
+  newMD          = primNewMD
+  readMD         = primReadMD
+  writeMD        = primWriteMD
+  unsafeFreezeMD = primUnsafeFreezeMD
+  sizeD          = primSizeD
+  sizeMD         = primSizeMD
+
+
+-- Float ----------------------------------------------------------------------
+instance DPrim Float where
+  mkDPrim            = DFloat
+  unDPrim (DFloat a) = a
+
+  mkMDPrim             = MDFloat
+  unMDPrim (MDFloat a) = a
+
+
+instance DT Float where
+  data Dist  Float   = DFloat  !(V.Vector    Float)
+  data MDist Float s = MDFloat !(MV.STVector s Float)
+
+  indexD         = primIndexD
+  newMD          = primNewMD
+  readMD         = primReadMD
+  writeMD        = primWriteMD
+  unsafeFreezeMD = primUnsafeFreezeMD
+  sizeD          = primSizeD
+  sizeMD         = primSizeMD
+
+
+-- Double ---------------------------------------------------------------------
+instance DPrim Double where
+  mkDPrim             = DDouble
+  unDPrim (DDouble a) = a
+
+  mkMDPrim              = MDDouble
+  unMDPrim (MDDouble a) = a
+
+
+instance DT Double where
+  data Dist  Double   = DDouble  !(V.Vector    Double)
+  data MDist Double s = MDDouble !(MV.STVector s Double)
+
+  indexD         = primIndexD
+  newMD          = primNewMD
+  readMD         = primReadMD
+  writeMD        = primWriteMD
+  unsafeFreezeMD = primUnsafeFreezeMD
+  sizeD          = primSizeD
+  sizeMD         = primSizeMD
+
+
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Tuple.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Tuple.hs
new file mode 100644 (file)
index 0000000..d9eaa4e
--- /dev/null
@@ -0,0 +1,132 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+{-# LANGUAGE CPP #-}
+#include "fusion-phases.h"
+
+-- | Distribution of Tuples
+module Data.Array.Parallel.Unlifted.Distributed.Types.Tuple (
+        -- * Pairs
+        zipD, unzipD, fstD, sndD,
+        
+        -- * Triples
+        zip3D, unzip3D
+) where
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Data.Array.Parallel.Base
+import Control.Monad
+
+here s = "Data.Array.Parallel.Unlifted.Distributed.Types.Tuple." ++ s
+
+
+-- Pairs ----------------------------------------------------------------------
+instance (DT a, DT b) => DT (a,b) where
+  data Dist  (a,b)   = DProd  !(Dist a)    !(Dist b)
+  data MDist (a,b) s = MDProd !(MDist a s) !(MDist b s)
+
+  indexD d i
+   = (fstD d `indexD` i,sndD d `indexD` i)
+
+  newMD g
+   = liftM2 MDProd (newMD g) (newMD g)
+
+  readMD  (MDProd xs ys) i
+   = liftM2 (,) (readMD xs i) (readMD ys i)
+
+  writeMD (MDProd xs ys) i (x,y)
+   = do writeMD xs i x
+        writeMD ys i y
+
+  unsafeFreezeMD (MDProd xs ys)
+   = liftM2 DProd (unsafeFreezeMD xs)
+                  (unsafeFreezeMD ys)
+
+  {-# INLINE deepSeqD #-}
+  deepSeqD (x, y) z 
+   = deepSeqD x (deepSeqD y z)
+
+  sizeD  (DProd  x _) = sizeD  x
+  sizeMD (MDProd x _) = sizeMD x
+
+  measureD (x, y) 
+   = "Pair " ++ "(" ++ measureD x ++ ") (" ++  measureD y ++ ")"
+
+
+-- | Pairing of distributed values.
+--   The two values must belong to the same 'Gang'.
+zipD :: (DT a, DT b) => Dist a -> Dist b -> Dist (a,b)
+{-# INLINE [0] zipD #-}
+zipD !x !y 
+        = checkEq (here "zipDT") "Size mismatch" (sizeD x) (sizeD y) 
+        $ DProd x y
+
+-- | Unpairing of distributed values.
+unzipD :: (DT a, DT b) => Dist (a,b) -> (Dist a, Dist b)
+{-# INLINE_DIST unzipD #-}
+unzipD (DProd dx dy) = (dx,dy)
+
+
+-- | Extract the first elements of a distributed pair.
+fstD :: (DT a, DT b) => Dist (a,b) -> Dist a
+{-# INLINE_DIST fstD #-}
+fstD = fst . unzipD
+
+
+-- | Extract the second elements of a distributed pair.
+sndD :: (DT a, DT b) => Dist (a,b) -> Dist b
+{-# INLINE_DIST sndD #-}
+sndD = snd . unzipD
+
+
+-- Triples --------------------------------------------------------------------
+instance (DT a, DT b, DT c) => DT (a,b,c) where
+  data Dist  (a,b,c)   = DProd3  !(Dist a)    !(Dist b)    !(Dist c)
+  data MDist (a,b,c) s = MDProd3 !(MDist a s) !(MDist b s) !(MDist c s)
+
+  indexD (DProd3 xs ys zs) i
+   = ( xs `indexD` i
+     , ys `indexD` i
+     , zs `indexD` i)
+
+  newMD g
+   = liftM3 MDProd3 (newMD g) (newMD g) (newMD g)
+
+  readMD  (MDProd3 xs ys zs) i
+   = liftM3 (,,) (readMD xs i) (readMD ys i) (readMD zs i)
+
+  writeMD (MDProd3 xs ys zs) i (x,y,z)
+   = do writeMD xs i x
+        writeMD ys i y
+        writeMD zs i z
+
+  unsafeFreezeMD (MDProd3 xs ys zs)
+   = liftM3 DProd3 (unsafeFreezeMD xs)
+                   (unsafeFreezeMD ys)
+                   (unsafeFreezeMD zs)
+
+  {-# INLINE deepSeqD #-}
+  deepSeqD (x,y,z) k 
+   = deepSeqD x (deepSeqD y (deepSeqD z k))
+
+  sizeD  (DProd3  x _ _) = sizeD  x
+  sizeMD (MDProd3 x _ _) = sizeMD x
+
+  measureD (x,y,z)
+   = "Triple " 
+        ++ "(" ++ measureD x ++ ") "
+        ++ "(" ++ measureD y ++ ") "
+        ++ "(" ++ measureD z ++ ")"
+
+
+-- | Pairing of distributed values.
+-- /The two values must belong to the same/ 'Gang'.
+zip3D   :: (DT a, DT b, DT c) => Dist a -> Dist b -> Dist c -> Dist (a,b,c)
+{-# INLINE [0] zip3D #-}
+zip3D !x !y !z
+        = checkEq (here "zip3DT") "Size mismatch" (sizeD x) (sizeD y) 
+        $ checkEq (here "zip3DT") "Size mismatch" (sizeD x) (sizeD z) 
+        $ DProd3 x y z
+
+
+-- | Unpairing of distributed values.
+unzip3D  :: (DT a, DT b, DT c) => Dist (a,b,c) -> (Dist a, Dist b, Dist c)
+{-# INLINE_DIST unzip3D #-}
+unzip3D (DProd3 dx dy dz) = (dx,dy,dz)
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/USegd.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/USegd.hs
new file mode 100644 (file)
index 0000000..0d25b9b
--- /dev/null
@@ -0,0 +1,88 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+{-# LANGUAGE CPP #-}
+#include "fusion-phases.h"
+
+-- | Distribution of Segment Descriptors
+module Data.Array.Parallel.Unlifted.Distributed.Types.USegd (
+        lengthUSegdD,
+        lengthsUSegdD,
+        indicesUSegdD,
+        elementsUSegdD
+) where
+import Data.Array.Parallel.Unlifted.Distributed.Types.Vector
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd
+import Data.Array.Parallel.Unlifted.Sequential.Vector
+import Control.Monad
+import Prelude                          as P
+
+
+instance DT USegd where
+  data Dist  USegd   
+        = DUSegd  !(Dist (Vector Int))
+                  !(Dist (Vector Int))
+                  !(Dist Int)
+
+  data MDist USegd s 
+        = MDUSegd !(MDist (Vector Int) s)
+                  !(MDist (Vector Int) s)
+                  !(MDist Int        s)
+
+  indexD (DUSegd lens idxs eles) i
+   = mkUSegd (indexD lens i) (indexD idxs i) (indexD eles i)
+
+  newMD g
+   = liftM3 MDUSegd (newMD g) (newMD g) (newMD g)
+
+  readMD (MDUSegd lens idxs eles) i
+   = liftM3 mkUSegd (readMD lens i) (readMD idxs i) (readMD eles i)
+
+  writeMD (MDUSegd lens idxs eles) i segd
+   = do writeMD lens i (lengthsUSegd  segd)
+        writeMD idxs i (indicesUSegd  segd)
+        writeMD eles i (elementsUSegd segd)
+
+  unsafeFreezeMD (MDUSegd lens idxs eles)
+   = liftM3 DUSegd (unsafeFreezeMD lens)
+                   (unsafeFreezeMD idxs)
+                   (unsafeFreezeMD eles)
+
+  deepSeqD segd z
+   = deepSeqD (lengthsUSegd  segd)
+   $ deepSeqD (indicesUSegd  segd)
+   $ deepSeqD (elementsUSegd segd) z
+
+  sizeD  (DUSegd  _ _ eles) = sizeD eles
+  sizeMD (MDUSegd _ _ eles) = sizeMD eles
+
+  measureD segd 
+   = "Segd " P.++ show (lengthUSegd segd) P.++ " " P.++ show (elementsUSegd segd)
+
+
+-- | O(1). Yield the overall number of segments.
+lengthUSegdD :: Dist USegd -> Dist Int
+{-# INLINE_DIST lengthUSegdD #-}
+lengthUSegdD (DUSegd lens _ _) 
+        = lengthD lens
+
+
+-- | O(1). Yield the lengths of the individual segments.
+lengthsUSegdD :: Dist USegd -> Dist (Vector Int)
+{-# INLINE_DIST lengthsUSegdD #-}
+lengthsUSegdD (DUSegd lens _ _ )
+        = lens
+
+
+-- | O(1). Yield the segment indices of a segment descriptor.
+indicesUSegdD :: Dist USegd -> Dist (Vector Int)
+{-# INLINE_DIST indicesUSegdD #-}
+indicesUSegdD (DUSegd _ idxs _)
+        = idxs
+
+
+-- | O(1). Yield the number of data elements.
+elementsUSegdD :: Dist USegd -> Dist Int
+{-# INLINE_DIST elementsUSegdD #-}
+elementsUSegdD (DUSegd _ _ dns)
+        = dns
+
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Unit.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Unit.hs
new file mode 100644 (file)
index 0000000..9834fa1
--- /dev/null
@@ -0,0 +1,45 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+{-# LANGUAGE CPP #-}
+#include "fusion-phases.h"
+
+-- | Distribution of unit values.
+module Data.Array.Parallel.Unlifted.Distributed.Types.Unit (
+        unitD
+) where
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Data.Array.Parallel.Unlifted.Distributed.Gang
+import Data.Array.Parallel.Base
+
+here s = "Data.Array.Parallel.Unlifted.Distributed.Types.Unit." ++ s
+
+
+instance DT () where
+  data Dist ()    = DUnit  !Int
+  data MDist () s = MDUnit !Int
+
+  indexD  (DUnit n) i
+   = check (here "indexD")  n i
+   $  ()
+
+  newMD
+   = return . MDUnit . gangSize
+
+  readMD   (MDUnit n) i
+   = check (here "readMD")  n i
+   $ return ()
+
+  writeMD  (MDUnit n) i ()
+   = check (here "writeMD") n i
+   $ return ()
+
+  unsafeFreezeMD (MDUnit n)
+   = return $ DUnit n
+
+  sizeD  = error $ here "sizeD  undefined"
+  sizeMD = error $ here "sizeMD undefined"
+
+
+-- | Yield a distributed unit.
+unitD :: Gang -> Dist ()
+{-# INLINE_DIST unitD #-}
+unitD = DUnit . gangSize
diff --git a/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Vector.hs b/dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Types/Vector.hs
new file mode 100644 (file)
index 0000000..e86e88f
--- /dev/null
@@ -0,0 +1,47 @@
+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}
+
+-- | Distribution of Vectors.
+module Data.Array.Parallel.Unlifted.Distributed.Types.Vector
+        (lengthD)
+where
+import Data.Array.Parallel.Unlifted.Distributed.Types.Prim      ()
+import Data.Array.Parallel.Unlifted.Distributed.Types.Base
+import Data.Array.Parallel.Unlifted.Distributed.Gang
+import Data.Array.Parallel.Unlifted.Sequential.Vector   as V
+import qualified Data.Vector                            as BV
+import qualified Data.Vector.Mutable                    as MBV
+import Prelude                                          as P
+import Control.Monad
+
+
+instance Unbox a => DT (V.Vector a) where
+  data Dist  (Vector a)   = DVector  !(Dist  Int)   !(BV.Vector      (Vector a))
+  data MDist (Vector a) s = MDVector !(MDist Int s) !(MBV.STVector s (Vector a))
+
+  indexD (DVector _ a) i
+   = a BV.! i
+
+  newMD g
+   = liftM2 MDVector (newMD g) 
+                        (MBV.replicate (gangSize g) (error "MDist (Vector a) - uninitalised"))
+
+  readMD (MDVector _ marr)
+   = MBV.read marr
+
+  writeMD (MDVector mlen marr) i a 
+   = do writeMD mlen i (V.length a)
+        MBV.write marr i $! a
+
+  unsafeFreezeMD (MDVector len a)
+   = liftM2 DVector (unsafeFreezeMD len)
+                    (BV.unsafeFreeze a)
+
+  sizeD  (DVector  _ a) = BV.length  a
+  sizeMD (MDVector _ a) = MBV.length a
+
+  measureD xs           = "Vector " P.++ show (V.length xs)
+
+
+-- | Yield the distributed length of a distributed array.
+lengthD :: Unbox a => Dist (Vector a) -> Dist Int
+lengthD (DVector l _) = l
index 9ae68ee..7a113ca 100644 (file)
@@ -25,6 +25,13 @@ Library
         Data.Array.Parallel.Unlifted.Distributed.Scalars
         Data.Array.Parallel.Unlifted.Distributed.Arrays
         Data.Array.Parallel.Unlifted.Distributed.Basics
+        Data.Array.Parallel.Unlifted.Distributed.Types.USegd
+        Data.Array.Parallel.Unlifted.Distributed.Types.Vector
+        Data.Array.Parallel.Unlifted.Distributed.Types.Maybe
+        Data.Array.Parallel.Unlifted.Distributed.Types.Tuple
+        Data.Array.Parallel.Unlifted.Distributed.Types.Prim
+        Data.Array.Parallel.Unlifted.Distributed.Types.Unit
+        Data.Array.Parallel.Unlifted.Distributed.Types.Base
         Data.Array.Parallel.Unlifted.Parallel.Combinators
         Data.Array.Parallel.Unlifted.Parallel.Sums
         Data.Array.Parallel.Unlifted.Parallel.Basics