Compare PArray functions against reference implementation
authorBen Lippmeier <benl@ouroborus.net>
Tue, 8 Nov 2011 04:53:16 +0000 (15:53 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Wed, 9 Nov 2011 05:29:00 +0000 (16:29 +1100)
23 files changed:
dph-base/Data/Array/Parallel/Array.hs
dph-lifted-reference/Data/Array/Parallel/PArray.hs [new file with mode: 0644]
dph-lifted-reference/LICENSE [new file with mode: 0644]
dph-lifted-reference/Setup.hs [new file with mode: 0644]
dph-lifted-reference/dph-lifted-reference.cabal [new file with mode: 0644]
dph-lifted-vseg/Data/Array/Parallel/Lifted/Closure.hs
dph-lifted-vseg/Data/Array/Parallel/PArray.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Base.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Double.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Int.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Nested.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Sum2.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Tuple.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Unit.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Void.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Wrap.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Base.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr/Instances.hs
dph-lifted-vseg/Data/Array/Parallel/Prim.hs
dph-lifted-vseg/dph-lifted-vseg.cabal
dph-test/test/PArray/PArray.hs

index a0bba4c..3d0431f 100644 (file)
@@ -1,5 +1,10 @@
 -- | Generic array class, used as a compatability layer during testing.
-module Data.Array.Parallel.Array where
+module Data.Array.Parallel.Array 
+        ( Array(..)
+        , fromList, toList
+        , toVectors1,   toVectors2,   toVectors3
+        , fromVectors1, fromVectors2, fromVectors3)
+where   
 import Control.Monad
 import Data.Vector              (Vector)
 import qualified Data.Vector    as V
@@ -65,3 +70,31 @@ toVectors3
 
 toVectors3 = V.map (V.map toVector) . V.map toVector . toVector 
         
+
+-- | Convert some vectors to an array.
+fromVectors1 
+        :: Array a e
+        => Vector e -> a e
+
+fromVectors1 vec
+        = fromVector vec
+        
+
+-- | Convert some vectors to a nested array
+fromVectors2 
+        :: (Array a1 (a2 e), Array a2 e)
+        => Vector (Vector e) -> a1 (a2 e)
+
+fromVectors2
+        = fromVector . V.map fromVector
+
+
+-- | Convert some vectors to a triply nested array
+fromVectors3 
+        :: (Array a1 (a2 (a3 e)), Array a2 (a3 e), Array a3 e)
+        => Vector (Vector (Vector e)) -> a1 (a2 (a3 e))
+
+fromVectors3
+        = fromVector . V.map fromVector . V.map (V.map fromVector)
+
+   
\ No newline at end of file
diff --git a/dph-lifted-reference/Data/Array/Parallel/PArray.hs b/dph-lifted-reference/Data/Array/Parallel/PArray.hs
new file mode 100644 (file)
index 0000000..00a0526
--- /dev/null
@@ -0,0 +1,189 @@
+
+module Data.Array.Parallel.PArray
+        ( PArray(..)
+        , valid
+        , nf
+        
+        -- * Constructors
+        , empty
+        , singleton,    singletonl
+        , replicate,    replicatel,     replicates
+        , append,       appendl
+        , concat,       concatl
+        
+        -- * Projections
+        , length,       lengthl
+        , index,        indexl
+        , extract)
+where
+import Data.Vector                              (Vector)
+import qualified Data.Array.Parallel.Unlifted   as U
+import qualified Data.Array.Parallel.Array      as A
+import qualified Data.Vector                    as V
+import Control.Monad
+import GHC.Exts
+import Prelude
+        hiding (replicate, length, concat)
+
+die fn str = error $ "Data.Array.Parallel.PArray: " ++ fn ++ " " ++ str
+
+-- | Parallel Ararys.
+data PArray a
+        = PArray Int# (Vector a)
+        deriving (Eq, Show)
+
+
+-- Array Instances ------------------------------------------------------------
+instance A.Array PArray a where
+ length  (PArray _ vec)
+        = V.length vec
+
+ index (PArray _ vec) ix
+        = vec V.! ix
+
+ append (PArray n1# xs) (PArray n2# ys)
+        = PArray (n1# +# n2#) (xs V.++ ys)
+
+ toVector (PArray _ vec)
+        = vec
+
+ fromVector vec
+  = case V.length vec of
+        I# n# -> PArray n# vec
+
+
+-- | Lift a unary array operator
+lift1 :: (a -> b) -> PArray a -> PArray b
+lift1 f (PArray n# vec)
+        = PArray n# $ V.map f vec
+
+
+-- | Lift a unary array operator
+lift2 :: (a -> b -> c) -> PArray a -> PArray b -> PArray c
+lift2 f (PArray n1# vec1) (PArray n2# vec2)
+ | I# n1# /= I# n2# 
+ = die "lift2" "length mismatch"
+ | otherwise
+ = PArray n1# $ V.zipWith f vec1 vec2
+
+
+-- Basics ---------------------------------------------------------------------
+-- | Check that an array has a valid internal representation.
+valid :: PArray a -> Bool
+valid _ = True
+
+-- | Force an array to normal form.
+nf :: PArray a -> ()
+nf _    = ()
+
+
+-- Constructors ----------------------------------------------------------------
+-- | O(1). An empty array.
+empty :: PArray a
+empty           = PArray 0# V.empty
+
+
+-- | O(1). Produce an array containing a single element.
+singleton :: a -> PArray a
+singleton x     = PArray 1# (V.singleton x)
+
+
+-- | O(n). Produce an array of singleton arrays.
+singletonl :: PArray a -> PArray (PArray a)
+singletonl = lift1 singleton
+
+
+-- | O(n). Define an array of the given size, that maps all elements to the same value.
+replicate :: Int -> a -> PArray a
+replicate n@(I# n#) x
+        = PArray n# (V.replicate n x)
+
+
+-- | O(sum lengths). Lifted replicate.
+replicatel :: PArray Int -> PArray a -> PArray (PArray a)
+replicatel = lift2 replicate
+
+
+-- | O(sum lengths). Segmented replicate.
+replicates :: U.Segd -> PArray a -> PArray a
+replicates segd (PArray n# vec)
+ | I# n# /= U.lengthSegd segd
+ = die "replicates"  
+        $ unlines 
+        [ "segd length mismatch"
+        , "  segd length  = " ++ show (U.lengthSegd segd)
+        , "  array length = " ++ show (I# n#) ]
+
+ | otherwise
+ = let  !(I# n2#) = U.elementsSegd segd
+   in   PArray n2# 
+         $ join $ V.zipWith V.replicate
+                        (V.convert $ U.lengthsSegd segd)
+                        vec
+
+
+-- | Append two arrays.
+append :: PArray a -> PArray a -> PArray a
+append (PArray n1# xs) (PArray n2# ys)
+        = PArray (n1# +# n2#) (xs V.++ ys)
+
+
+-- | Lifted append.
+appendl :: PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)
+appendl = lift2 append
+
+
+-- | Concatenation
+concat :: PArray (PArray a) -> PArray a
+concat (PArray _ xss)
+ = let  xs       = join $ V.map A.toVector xss
+        !(I# n') = V.length xs
+   in   PArray n' xs
+
+
+-- | Lifted concatenation
+concatl :: PArray (PArray (PArray a)) -> PArray (PArray a)
+concatl = lift1 concat
+
+-----------------------------------------------------------
+-- TODO: unconcat
+-----------------------------------------------------------
+
+-----------------------------------------------------------
+-- TODO: nestUSegd
+-----------------------------------------------------------
+
+
+-- Projections ----------------------------------------------------------------
+-- | Take the length of an array
+length :: PArray a -> Int
+length (PArray n# _)    = I# n#
+
+
+-- | Take the length of some arrays.
+lengthl :: PArray (PArray a) -> PArray Int
+lengthl = lift1 length
+
+
+-- | Lookup a single element from the source array.
+index :: PArray a -> Int -> a
+index (PArray _ arr) ix
+        = arr V.! ix
+
+
+-- | Lookup a several elements from several source arrays.
+indexl :: PArray (PArray a) -> PArray Int -> PArray a
+indexl  = lift2 index
+
+
+-- | Extract a range of elements from an array.
+extract :: PArray a -> Int -> Int -> PArray a
+extract (PArray _ vec) start len@(I# len#)
+        = PArray len# $ V.slice start len vec
+
+
+
+
+
+
diff --git a/dph-lifted-reference/LICENSE b/dph-lifted-reference/LICENSE
new file mode 100644 (file)
index 0000000..235f8f1
--- /dev/null
@@ -0,0 +1,37 @@
+Copyright (c) 2001-2011, The DPH Team
+All rights reserved.
+
+The DPH Team is:
+  Manuel M T Chakravarty
+  Gabriele Keller
+  Roman Leshchinskiy
+  Ben Lippmeier
+  George Roldugin
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
diff --git a/dph-lifted-reference/Setup.hs b/dph-lifted-reference/Setup.hs
new file mode 100644 (file)
index 0000000..200a2e5
--- /dev/null
@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+
diff --git a/dph-lifted-reference/dph-lifted-reference.cabal b/dph-lifted-reference/dph-lifted-reference.cabal
new file mode 100644 (file)
index 0000000..824d581
--- /dev/null
@@ -0,0 +1,66 @@
+Name:           dph-lifted-reference
+Version:        0.5.2.0
+License:        BSD3
+License-File:   LICENSE
+Author:         The DPH Team
+Maintainer:     Ben Lippmeier <benl@cse.unsw.edu.au>
+Homepage:       http://www.haskell.org/haskellwiki/GHC/Data_Parallel_Haskell
+Category:       Data Structures
+Synopsis:       Sequential reference implementation of lifted DPH array primitives.
+
+Cabal-Version:  >= 1.6
+Build-Type:     Simple
+
+Library
+  -- This Cabal file is CPPed,
+  --   then put in ../build/dph-lifted-copy-par and ../build/dph-lifted-copy-seq
+  -- We therefore need to point back at the original location for where to find the sources
+  HS-Source-Dirs: ../dph-lifted-reference
+
+  Exposed-Modules:
+        Data.Array.Parallel.PArray
+
+  Include-Dirs:
+        include
+
+  Extensions:
+        CPP,
+        BangPatterns,
+        PatternGuards
+        TypeFamilies,
+        TypeOperators,
+        RankNTypes,
+        BangPatterns,
+        MagicHash,
+        UnboxedTuples,
+        TypeOperators,
+        FlexibleContexts,
+        FlexibleInstances,
+        EmptyDataDecls,
+        NoMonomorphismRestriction,
+        MultiParamTypeClasses,
+        EmptyDataDecls,
+        StandaloneDeriving,
+        ExplicitForAll,
+        ParallelListComp,
+        PatternGuards,
+        ExistentialQuantification,
+        ScopedTypeVariables
+        
+
+  GHC-Options: 
+        -Wall -fno-warn-orphans -fno-warn-missing-signatures
+        -Odph 
+        -funbox-strict-fields
+        -fcpr-off
+  
+  Build-Depends:  
+        base             == 4.4.*,
+        ghc              == 7.*,
+        array            == 0.3.*,
+        pretty           == 1.1.*,
+        vector           == 0.9.*,
+        containers       == 0.4.*,
+        dph-base         == 0.5.*,
+        dph-prim-par     == 0.5.*
+
index 2f3940a..a4457a8 100644 (file)
@@ -13,10 +13,12 @@ module Data.Array.Parallel.Lifted.Closure (
   closure1,  closure2,  closure3,
   closure1', closure2', closure3'  
 ) where
+import Data.Array.Parallel.Pretty
 import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.PArray.PData.Unit
 import Data.Array.Parallel.PArray.PData.Tuple
 import Data.Array.Parallel.PArray.PRepr
+import qualified Data.Vector            as V
 import GHC.Exts
 
 
@@ -205,24 +207,40 @@ closure3' fv fl
 -- to break an import loop.
 --
 instance PR (a :-> b) where
+
   {-# INLINE_PDATA validPR #-}
   validPR (AClo _ _ env)
         = validPA env
 
+  {-# INLINE_PDATA nfPR #-}
+  nfPR (AClo fv fl envs)
+        = fv `seq` fl `seq` nfPA envs `seq` ()
+
+  -- We can't test functions for equality.
+  -- We can't test the environments either, because they're existentially quantified.
+  -- Let's just call them equal... similarPA is just for testing anyway.
+  {-# INLINE_PDATA similarPR #-}
+  similarPR _ _
+        = True
+
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (AClo _ _ envs) ix
+        = coversPA weak envs ix
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (AClo _ _ env)
+        = vcat
+        [ text "AClo"
+        , pprpDataPA env ]
+
+
+  -- Constructors -------------------------------
   {-# INLINE_PDATA emptyPR #-}
   emptyPR
         = AClo  (\_ _ -> error "empty array closure")
                 (\_ _ -> error "empty array closure")
                 (emptyPA :: PData ())
 
-  {-# INLINE_PDATA nfPR #-}
-  nfPR (AClo fv fl envs)
-        = fv `seq` fl `seq` nfPA envs `seq` ()
-
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (AClo _ _ envs)
-        = lengthPA envs
-
   {-# INLINE_PDATA replicatePR #-}
   replicatePR n (Clo fv fl envs)
         = AClo fv fl (replicatePA n envs)
@@ -231,10 +249,18 @@ instance PR (a :-> b) where
   replicatesPR lens (AClo fv fl envs)
         = AClo fv fl (replicatesPA lens envs)
 
+
+  -- Projections --------------------------------
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (AClo _ _ envs)
+        = lengthPA envs
+
   {-# INLINE_PDATA indexPR #-}
   indexPR (AClo fv fl envs) ix
         = Clo fv fl (indexPA envs ix)
 
+
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA extractPR #-}
   extractPR (AClo fv fl envs) start len
         = AClo fv fl (extractPA envs start len)
@@ -245,6 +271,11 @@ instance PR (a :-> b) where
         = AClo fv fl (packByTagPA envs tags tag)
 
 
+  -- Conversions --------------------------------
+  toVectorPR (AClo fv fl envs)
+   = V.map (Clo fv fl) $ toVectorPA envs
+
+
   -- TODO: not sure about these.
   --       we can't just extract the env because the vector may
   --       contain closures with multiple functions.
@@ -255,7 +286,7 @@ instance PR (a :-> b) where
   appendsPR     = error     "appendPR[:->]: not defined"
   combine2PR    = error    "combinePR[:->]: not defined"
   fromVectorPR  = error "fromVectorPR[:->]: not defined"
-  toVectorPR    = error   "toVectorPR[:->]: not defined"
+
 
 
 -- PRepr Instance -------------------------------------------------------------
index fbff422..b005ec0 100644 (file)
@@ -27,16 +27,16 @@ module Data.Array.Parallel.PArray
         -- * Constructors
         , empty
         , singleton,    singletonl
-        , replicate,    replicatel,     replicates
+        , replicate,    replicatel,     replicates,     replicates'
         , append,       appendl
         , concat,       concatl
         , unconcat
         , nestUSegd
 
         -- * Projections
-        , length,       lengthl          -- length from D.A.P.PArray.PData.Base
+        , length,       lengthl         -- length from D.A.P.PArray.PData.Base
         , index,        indexl
-        , extract,      extracts, extracts'
+        , extract,      extracts,       extracts'
         , slice,        slicel
         , unsafeTakeSegd
 
@@ -58,12 +58,15 @@ module Data.Array.Parallel.PArray
         , fromUArray,   toUArray        -- from D.A.P.PArray.Scalar
        , fromUArray2)                  -- from D.A.P.PArray.Scalar
 where
+import qualified Data.Array.Parallel.Pretty     as T
 import Data.Array.Parallel.PArray.PData
 import Data.Array.Parallel.PArray.PRepr
 import Data.Array.Parallel.PArray.Scalar
 import GHC.Exts
 import Data.Vector                              (Vector)
 import Data.Array.Parallel.Base                 (Tag)
+import qualified "dph-lifted-reference" Data.Array.Parallel.PArray as R
+import qualified Data.Array.Parallel.Array      as A
 import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Vector                    as V
 import qualified Prelude                        as P
@@ -71,19 +74,69 @@ import Prelude hiding
         ( length, replicate, concat
         , enumFromTo
         , zip, unzip)
+import Debug.Trace
+
+-- Tracing --------------------------------------------------------------------
+-- TODO: we could use this to trace the lengths of the vectors being used, 
+--       as well as the types that each opeartor is being called at.
+
+instance PA e => A.Array PArray e where
+ length arr     = length arr
+ index          = index
+ append         = append
+ toVector       = toVector
+ fromVector     = fromVector
+
+-- TODO: shift this stuff to the reference implementation module.
+--       make the PArray constructor polymorphic
+-- | Compare a flat array against a reference
+withRef1 :: PA a => String -> R.PArray a -> PArray a -> PArray a
+withRef1 name arrRef arrImpl
+ = trace (T.render $ T.text name T.$$ T.pprp arrImpl)
+ $ if (  valid arrImpl
+      && A.length arrRef == A.length arrImpl
+      && (V.and $ V.zipWith
+                similarPA
+                (A.toVectors1 arrRef) (A.toVectors1 arrImpl)))
+    then arrImpl
+    else error $ "withRef: failure " ++ name
+
+
+withRef2 :: PA a => String -> R.PArray (R.PArray a) -> PArray (PArray a) -> PArray (PArray a)
+withRef2 name arrRef arrImpl
+ = trace (T.render $ T.text name T.$$ T.pprp arrImpl)
+ $ if (  valid arrImpl
+      && A.length arrRef == A.length arrImpl
+      && (V.and $ V.zipWith 
+                (\xs ys -> V.and $ V.zipWith similarPA xs ys)
+                (A.toVectors2 arrRef) (A.toVectors2 arrImpl)))
+    then arrImpl
+    else error $ "withRef: failure " ++ name
+
+
+-- TODO: shift this stuff to the reference implementation module.
+--       make the parray constructor polymorphic.
+toRef1 :: PA a => PArray a -> R.PArray a
+toRef1  = A.fromVectors1 . A.toVectors1
+
+toRef2 :: PA a => PArray (PArray a) -> R.PArray (R.PArray a)
+toRef2  = A.fromVectors2 . A.toVectors2
+
+toRef3 :: PA a => PArray (PArray (PArray a)) -> R.PArray (R.PArray (R.PArray a))
+toRef3  = A.fromVectors3 . A.toVectors3
 
 
+-- Basics ---------------------------------------------------------------------
 instance (Eq a, PA a)  => Eq (PArray a) where
  (==) (PArray _ xs) (PArray _ ys) = toVectorPA xs == toVectorPA ys
  (/=) (PArray _ xs) (PArray _ ys) = toVectorPA xs /= toVectorPA ys
 
 
--- Basics ---------------------------------------------------------------------
 -- | Check that an array has a valid internal representation.
 valid :: PA a => PArray a -> Bool
 valid (PArray n# darr1)
-        =  validPA darr1
-        && validBool "parray length" (I# n# == lengthPA darr1)
+        =  validPA  darr1
+        && coversPA True darr1 (I# n#)
 {-# INLINE_PA valid #-}
 
 
@@ -97,21 +150,26 @@ nf (PArray n# d)
 -- Constructors ----------------------------------------------------------------
 -- | O(1). An empty array.
 empty :: PA a => PArray a
-empty   = PArray 0# emptyPA
+empty
+ = withRef1 "empty" R.empty
+ $ PArray 0# emptyPA
+
 {-# INLINE_PA empty #-}
 
 
 -- | O(1). Produce an array containing a single element.
 singleton :: PA a => a -> PArray a
 singleton x
-        = PArray 1# (replicatePA 1 x)
+ = withRef1 "singleton" (R.singleton x)
+ $ PArray 1# (replicatePA 1 x)
 {-# INLINE_PA singleton #-}
 
 
 -- | O(n). Produce an array of singleton arrays.
 singletonl :: PA a => PArray a -> PArray (PArray a)
 singletonl arr
-        = replicatel (replicate (length arr) 1) arr
+ = withRef2 "singletonl" (R.singletonl (toRef1 arr))
+ $ replicatel (replicate (length arr) 1) arr
 {-# INLINE_PA singletonl #-}
 
 
@@ -119,65 +177,81 @@ singletonl arr
 --   We require the replication count to be > 0 so that it's easier to maintain
 --   the validPR invariants for nested arrays.
 replicate :: PA a => Int -> a -> PArray a
-replicate (I# n#) x
-        = PArray n# (replicatePA (I# n#) x)
+replicate n@(I# n#) x
+ = withRef1 "replicate" (R.replicate n x)
+ $ PArray n# (replicatePA (I# n#) x)
 {-# INLINE_PA replicate #-}
 
 
 -- | O(sum lengths). Lifted replicate.
 replicatel :: PA a => PArray Int -> PArray a -> PArray (PArray a)
-replicatel (PArray 0# _) _       = empty
-replicatel (PArray n# (PInt lens)) (PArray _ pdata)
- = let  segd    = U.lengthsToSegd lens
+replicatel reps@(PArray n# (PInt lens)) arr@(PArray _ pdata)
+ = withRef2 "replicatel" (R.replicatel (toRef1 reps) (toRef1 arr))
+ $ if n# ==# 0# then empty else 
+    let segd    = U.lengthsToSegd lens
         pdata'  = replicatesPA segd pdata
         c       = I# n#
         
-   in   PArray n# 
+     in PArray n# 
          $ mkPNested
                 (U.enumFromTo 0 (c - 1))
                 lens
                 (U.indicesSegd segd)
                 (U.replicate c 0)
                 (singletondPA pdata')
+
 {-# INLINE_PA replicatel #-}
 
 
 -- | O(sum lengths). Segmented replicate.
 replicates :: PA a => U.Segd -> PArray a -> PArray a
-replicates segd (PArray _ pdata)
- = let  !(I# n#) = U.elementsSegd segd
+replicates segd arr@(PArray _ pdata)
+ = withRef1 "replicates" (R.replicates segd (toRef1 arr))
+ $ let  !(I# n#) = U.elementsSegd segd
    in   PArray n# $ replicatesPA segd pdata
 {-# INLINE_PA replicates #-}
 
 
+-- | O(sum lengths). Wrapper for segmented replicate that takes replication counts
+--  and uses them to build the `U.Segd`.
+replicates' :: PA a => PArray Int -> PArray a -> PArray a
+replicates' (PArray _ (PInt reps)) arr
+ = replicates (U.lengthsToSegd reps) arr
+{-# INLINE_PA replicates' #-}
 -- | Append two arrays.
 append :: PA a => PArray a -> PArray a -> PArray a
-append (PArray n1# darr1) (PArray n2# darr2)
-        = PArray (n1# +# n2#) (appendPA darr1 darr2)
+append arr1@(PArray n1# darr1) arr2@(PArray n2# darr2)
+ = withRef1 "append" (R.append (toRef1 arr1) (toRef1 arr2))
+ $ PArray (n1# +# n2#) (appendPA darr1 darr2)
 {-# INLINE_PA append #-}
 
 
 -- | Lifted append.
 --   Both arrays must have the same length
 appendl :: PA a => PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)
-appendl (PArray n# pdata1) (PArray _ pdata2)
-        = PArray n# $ appendlPA pdata1 pdata2
+appendl arr1@(PArray n# pdata1) arr2@(PArray _ pdata2)
+ = withRef2 "appendl" (R.appendl (toRef2 arr1) (toRef2 arr2))
+ $ PArray n# $ appendlPA pdata1 pdata2
 {-# INLINE_PA appendl #-}
 
 
 -- | Concatenate a nested array.
 concat :: PA a => PArray (PArray a) -> PArray a
-concat (PArray _ darr)
- = let  darr'    = concatPA darr
-        !(I# n#) = lengthPA darr'
+concat arr@(PArray _ darr)
+ = withRef1 "concat" (R.concat (toRef2 arr))
+ $ let  darr'    = concatPA darr
+        !(I# n#)        = lengthPA darr'
    in   PArray  n# darr'
 {-# INLINE_PA concat #-}
 
 
 -- | Lifted concat.
 concatl :: PA a => PArray (PArray (PArray a)) -> PArray (PArray a)
-concatl (PArray n# pdata1)
-        = PArray n# $ concatlPA pdata1
+concatl arr@(PArray n# pdata1)
+ = withRef2 "concatl" (R.concatl (toRef3 arr))
+ $ PArray n# $ concatlPA pdata1
 {-# INLINE_PA concatl #-}
 
 
@@ -305,37 +379,33 @@ pack (PArray _ xs) (PArray _ (PBool sel2))
 
 
 -- | Lifted pack.
---   Both data and tag arrays must have the same segmentation structure, 
+--   Both data and tag arrays must have the same virtual segmentation structure, 
 --   but this is not checked.
---   BROKEN: this will be wrong because we're ignoring the second vsegd
-packl :: forall a. PA a => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
-packl xss bss
- | PArray n# (PNested vsegd xdatas)     <- xss
- , PArray _  (PNested _     bdatas)     <- bss
+packl :: PA a => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
+packl xss fss
+ | PArray n# xdata@(PNested vsegd _)    <- xss
+ , PArray _  fdata                      <- fss
  = let  
-        -- Split up the vsegd into its parts.
-        vsegids         = U.takeVSegidsOfVSegd  vsegd
-        ssegd           = U.takeSSegdOfVSegd    vsegd
-
-        -- Gather the scattered data together into contiguous arrays, 
-        -- which is the form packByTag needs.
-        xdata_contig            = extractsPA xdatas ssegd
-        bdata'@(PBool sel2)     = extractsPA bdatas ssegd
-        tags                    = U.tagsSel2 sel2
-         
-        -- Pack all the psegs.
-        xdata'          = packByTagPA xdata_contig tags 1
-
-        -- Rebuild the segd to account for the possibly smaller segments.
-        segd            = U.lengthsToSegd $ U.lengthsSSegd ssegd
+        -- Demote the vsegd to get the virtual segmentation of the two arrays.
+        -- The virtual segmentation of both must be the same, but this is not checked.
+        segd            = U.demoteToSegdOfVSegd vsegd
+        
+        -- Concatenate both arrays to get the flat data.
+        --   Although the virtual segmentation should be the same,
+        --   the physical segmentation of both arrays may be different.
+        xdata_flat              = concatPA xdata
+        fdata_flat@(PBool sel)  = concatPA fdata
+        tags                    = U.tagsSel2 sel
+        
+        -- Count how many elements go into each segment.        
         segd'           = U.lengthsToSegd $ U.count_s segd tags 1
 
-        -- Reattach the vsegids, because the top level sharing structure
-        -- of the array is unchanged under pack.
-        vsegd'          = U.mkVSegd vsegids (U.promoteSegdToSSegd segd')
-
-   in   PArray n# (PNested vsegd' (singletondPA xdata'))
-      
+        -- Build the result array
+        vsegd'          = U.promoteSegdToVSegd segd'
+        xdata'          = packByTagPA xdata_flat tags 1
+        
+   in   PArray n# (PNested vsegd' $ singletondPA xdata')
+{-# INLINE_PA packl #-}
 
 
 -- | Filter an array based on some tags.
@@ -343,7 +413,8 @@ packByTag :: PA a => PArray a -> U.Array Tag -> Tag -> PArray a
 packByTag (PArray _ darr) tags tag
  = let  darr'           = packByTagPA darr tags tag
         !(I# n#)        = lengthPA darr'
-   in   PArray n# darr'
+   in   PArray  n# darr'
+
 {-# INLINE_PA packByTag #-}
 
 
@@ -352,7 +423,7 @@ combine2  :: PA a => U.Sel2 -> PArray a -> PArray a -> PArray a
 combine2 sel (PArray _ darr1) (PArray _ darr2)
  = let  darr'           = combine2PA sel darr1 darr2
         !(I# n#)        = lengthPA darr'
-   in   PArray n# darr'
+   in   PArray  n# darr'
 {-# INLINE_PA combine2 #-}
 
 
index 45f0eb4..fd571c8 100644 (file)
@@ -7,7 +7,6 @@ module Data.Array.Parallel.PArray.PData
         , module Data.Array.Parallel.PArray.PData.Nested
         , module Data.Array.Parallel.PArray.PData.Unit
         , module Data.Array.Parallel.PArray.PData.Tuple
-        , module Data.Array.Parallel.PArray.PData.Void
         , fromListPR
         , toListPR
         , mapdPR
@@ -20,8 +19,8 @@ import Data.Array.Parallel.PArray.PData.Double
 import Data.Array.Parallel.PArray.PData.Nested
 import Data.Array.Parallel.PArray.PData.Sum2
 import Data.Array.Parallel.PArray.PData.Unit
-import Data.Array.Parallel.PArray.PData.Tuple
 import Data.Array.Parallel.PArray.PData.Void
+import Data.Array.Parallel.PArray.PData.Tuple
 import Data.Array.Parallel.PArray.PRepr.Instances
 import Data.Array.Parallel.Base                 (Tag)
 import qualified Data.Array.Parallel.Unlifted   as U
index 3dbe175..f47675c 100644 (file)
@@ -39,7 +39,6 @@ import Prelude hiding (length)
 data PArray a
         = PArray Int# (PData  a)
 
-
 -- | Take the length of an array
 {-# INLINE_PA length #-}
 length :: PArray a -> Int
@@ -71,24 +70,37 @@ data instance PDatas Int
 -- PR -------------------------------------------------------------------------
 class PR a where
 
+  -- House Keeping ------------------------------
+  --  These methods are helpful for debugging, but we don't want their
+  --  associated type classes as superclasses of PR.
+
   -- | 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
-
   -- | Ensure there are no thunks in the representation of a manifest array.
   nfPR          :: PData a -> ()
 
-  -- | Get the number of elements in an array.
-  --   For nested arrays this is just the length of the top level of nesting,
-  --   not the total number of elements in the array.
+  -- | Weak equality of contained elements.
+  --   Returns True for functions of the same type.  
+  --   In the case of nested arrays, this ignores the physical representation,
+  --   that is, it doesn't care about the exact form of segment descriptors.
+  similarPR     :: a -> a -> Bool
 
-  --   TODO: We want a length function so we can use it in validPR,
-  --         but it should return  Nothing when the array is 'defined everywhere', 
-  --         like with arrays of ().
-  lengthPR      :: PData a -> Int
+  -- | Check that an index is within this array.
+  --   The (PData Void) arrays don't have a real length, but we still want to
+  --   to check that indices are in-range during testing.
+  --   If the array has a hard length, and the flag is True, then we allow
+  --   the index to be equal to this length.
+  coversPR      :: Bool -> PData a -> Int   -> Bool
+
+  -- | Pretty print the physical representation of this array.
+  pprpDataPR    :: PData a -> Doc
+
+
+  -- Constructors -------------------------------
+  -- | Produce an empty array with size zero.
+  emptyPR       :: PData a
 
   -- | Define an array of the given size, that maps all elements to the same value.
   --   We require the replication count to be > 0 so that it's easier to maintain
@@ -99,15 +111,30 @@ class PR a where
                 -> PData a
 
   -- | O(sum lengths). Segmented replicate.
-  --   NOTE: This takes a whole Segd instead of just the lengths, because we can
-  --   do it more efficiently if we know there are no zero lengths.
-  --   TODO: the Segd should actually keep track of whether there are zero lengths.
+  --   TODO: This takes a whole Segd instead of just the lengths, because we could
+  --         do it more efficiently if we knew there were no zero lengths.
   replicatesPR  :: U.Segd               -- ^ segment descriptor defining the lengths of the segments.
                 -> PData a              -- ^ data elements to replicate
                 -> PData a
 
+  -- | Append two sized arrays.
+  appendPR      :: PData a -> PData a -> PData a
+
+  -- | Segmented append
+  appendsPR     :: U.Segd               -- ^ segd of result
+                -> U.Segd -> PData a    -- ^ segd/data of first  arrays
+                -> U.Segd -> PData a    -- ^ segd/data of second arrays
+                -> PData a
+
+
+  -- Projections --------------------------------
+  -- | O(1). Get the length of an array, if it has one.
+  --   A (PData Void) array has no length, so this returns `error` in that case.
+  --   To check array bounds, use coversPR instead, as that's a total function.
+  lengthPR      :: PData a -> Int
+  
   -- | O(1). Lookup a single element from the source array.
-  indexPR       :: PData a    -> Int -> a
+  indexPR       :: PData a -> Int -> a
 
   -- | Lookup several elements from several source arrays
   indexlPR      :: PData (PArray a)
@@ -125,20 +152,13 @@ class PR a where
                 -> U.SSegd              -- ^ segment descriptor describing scattering of data.
                 -> PData a
 
-  -- | Append two sized arrays.
-  appendPR      :: PData a -> PData a -> PData a
-
-  -- | Segmented append
-  appendsPR     :: U.Segd               -- ^ segd of result
-                -> U.Segd -> PData a    -- ^ segd/data of first  arrays
-                -> U.Segd -> PData a    -- ^ segd/data of second arrays
-                -> PData a
-
   -- | Backwards permutation
   bpermutePR    :: PData a              -- ^ source array
                 -> U.Array Int          -- ^ source indices
                 -> PData a
 
+
+  -- Pack and Combine ---------------------------
   -- | Filter an array based on some tags.
   packByTagPR   :: PData a              -- ^ source array
                 -> U.Array Tag          -- ^ array of tags
@@ -151,14 +171,16 @@ class PR a where
                 -> PData a              -- ^ second source array
                 -> PData a
 
-  -- Conversions ---------------------
+
+  -- Conversions --------------------------------
   -- | Convert a boxed vector to an array.
   fromVectorPR  :: Vector a -> PData a
 
   -- | Convert an array to a boxed vector.
   toVectorPR    :: PData a -> Vector a
 
-  -- PDatas --------------------------
+
+  -- PDatas -------------------------------------
   -- | O(1). Yield an empty collection of PData.
   emptydPR      :: PDatas a
 
@@ -184,13 +206,17 @@ class PR a where
   toVectordPR   :: PDatas a           -> V.Vector (PData a)
 
 
-instance (PR a, PprPhysical (PData a)) => PprPhysical (PDatas a) where
+instance PR a  => PprPhysical (PData a) where
+ pprp = pprpDataPR
+
+instance PR a  => PprPhysical (PDatas a) where
  pprp pdatas
   = vcat
   $ [ int n <> colon <> text " " <> pprp pd
         | n  <- [0..]
         | pd <- V.toList $ toVectordPR pdatas]
 
+
 -------------------------------------------------------------------------------
 -- extra unlifted primitives should be moved into unlifted library ------------
 -------------------------------------------------------------------------------
index 5c20afe..f198927 100644 (file)
@@ -8,6 +8,7 @@ import qualified Data.Vector                    as V
 import qualified Data.Vector.Unboxed            as VU
 import Text.PrettyPrint
 
+
 data instance PData Double
         = PDouble !(U.Array Double)
 
@@ -15,23 +16,35 @@ data instance PDatas Double
         = PDoubles !(V.Vector (U.Array Double))
 
 
-
+-- PR -------------------------------------------------------------------------
 instance PR Double where
+
   {-# INLINE_PDATA validPR #-}
   validPR _
         = True
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR
-        = PDouble U.empty
-
   {-# INLINE_PDATA nfPR #-}
   nfPR (PDouble xx)
         = xx `seq` ()
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PDouble xx)
-        = U.length xx
+  {-# INLINE_PDATA similarPR #-}
+  similarPR  = (==)
+
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PDouble uarr) ix
+   | weak       = ix <= U.length uarr
+   | otherwise  = ix <  U.length uarr
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (PDouble vec)
+   =   text "PDouble"
+   <+> text (show $ U.toList vec)
+
+
+  -- Constructors -------------------------------
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR
+        = PDouble U.empty
 
   {-# INLINE_PDATA replicatePR #-}
   replicatePR len x
@@ -40,7 +53,21 @@ instance PR Double where
   {-# INLINE_PDATA replicatesPR #-}
   replicatesPR segd (PDouble arr)
         = PDouble (U.replicate_s segd arr)
-                
+
+  {-# INLINE_PDATA appendPR #-}
+  appendPR (PDouble arr1) (PDouble arr2)
+        = PDouble (arr1 U.+:+ arr2)
+
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR segdResult segd1 (PDouble arr1) segd2 (PDouble arr2)
+        = PDouble $ U.append_s segdResult segd1 arr1 segd2 arr2
+
+
+  -- Projections --------------------------------                
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (PDouble uarr)
+        = U.length uarr
+
   {-# INLINE_PDATA indexPR #-}
   indexPR (PDouble arr) ix
         = arr `VU.unsafeIndex` ix
@@ -75,14 +102,8 @@ instance PR Double where
          seglens        = U.lengthsSSegd ussegd
      in  PDouble (uextracts vecpdatas segsrcs segstarts seglens)
                 
-  {-# INLINE_PDATA appendPR #-}
-  appendPR (PDouble arr1) (PDouble arr2)
-        = PDouble (arr1 U.+:+ arr2)
-
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PDouble arr1) segd2 (PDouble arr2)
-        = PDouble $ U.append_s segdResult segd1 arr1 segd2 arr2
 
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR (PDouble arr1) arrTags tag
         = PDouble $ U.packByTag arr1 arrTags tag
@@ -93,6 +114,8 @@ instance PR Double where
                            (U.repSel2  sel)
                            arr1 arr2)
 
+
+  -- Conversions --------------------------------
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR xx
         = PDouble (U.fromList $ V.toList xx)
@@ -101,6 +124,7 @@ instance PR Double where
   toVectorPR (PDouble arr)
         = V.fromList $ U.toList arr
 
+
   -- PDatas -------------------------------------
   {-# INLINE_PDATA emptydPR #-}
   emptydPR 
@@ -141,11 +165,7 @@ instance PR Double where
 deriving instance Show (PData  Double)
 deriving instance Show (PDatas Double)
 
-instance PprPhysical (PData Double) where
-  pprp (PDouble vec)
-   =   text "PDouble"
-   <+> text (show $ U.toList vec)
-
 instance PprVirtual (PData Double) where
   pprv (PDouble vec)
    = text (show $ U.toList vec)
+
index 92d954d..471e034 100644 (file)
@@ -9,23 +9,35 @@ import qualified Data.Vector.Unboxed            as VU
 import Text.PrettyPrint
 import Prelude                                  as P
 
+
 -- PR -------------------------------------------------------------------------
 instance PR Int where
+
   {-# INLINE_PDATA validPR #-}
   validPR _
         = True
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR
-        = PInt U.empty
-
   {-# INLINE_PDATA nfPR #-}
   nfPR (PInt xx)
         = xx `seq` ()
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PInt xx)
-        = U.length xx
+  {-# INLINE_PDATA similarPR #-}
+  similarPR  = (==)
+
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PInt uarr) ix
+   | weak       = ix <= U.length uarr
+   | otherwise  = ix <  U.length uarr
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (PInt uarr)
+   =    text "PInt" <+> pprp uarr
+
+
+  -- Constructors -------------------------------
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR
+        = PInt U.empty
 
   {-# INLINE_PDATA replicatePR #-}
   replicatePR len x
@@ -35,9 +47,23 @@ instance PR Int where
   replicatesPR segd (PInt arr)
         = PInt (U.replicate_s segd arr)
                 
+  {-# INLINE_PDATA appendPR #-}
+  appendPR (PInt arr1) (PInt arr2)
+        = PInt $ arr1 U.+:+ arr2
+
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR segdResult segd1 (PInt arr1) segd2 (PInt arr2)
+        = PInt $ U.append_s segdResult segd1 arr1 segd2 arr2
+
+
+  -- Projections --------------------------------                
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (PInt uarr) 
+        = U.length uarr
+
   {-# INLINE_PDATA indexPR #-}
-  indexPR (PInt arr) ix
-        = arr U.!: ix
+  indexPR (PInt uarr) ix
+        = uarr U.!: ix
 
   {-# INLINE_PDATA indexlPR #-}
   indexlPR arr@(PNested vsegd (PInts vecpdatas)) (PInt ixs)
@@ -68,19 +94,13 @@ instance PR Int where
          segstarts      = U.startsSSegd  ussegd
          seglens        = U.lengthsSSegd ussegd
      in  PInt $ uextracts vecpdatas segsrcs segstarts seglens
-                
-  {-# INLINE_PDATA appendPR #-}
-  appendPR (PInt arr1) (PInt arr2)
-        = PInt $ arr1 U.+:+ arr2
-
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PInt arr1) segd2 (PInt arr2)
-        = PInt $ U.append_s segdResult segd1 arr1 segd2 arr2
 
   {-# INLINE_PDATA bpermutePR #-}
   bpermutePR (PInt arr) indices
         = PInt $ U.bpermute arr indices
 
+
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR (PInt arr1) arrTags tag
         = PInt $ U.packByTag arr1 arrTags tag
@@ -91,6 +111,8 @@ instance PR Int where
                            (U.repSel2  sel)
                            arr1 arr2
 
+
+  -- Conversions --------------------------------
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR xx
         = PInt $U.fromList $ V.toList xx
@@ -99,7 +121,8 @@ instance PR Int where
   toVectorPR (PInt arr)
         = V.fromList $ U.toList arr
 
-  -- PRR ----------------------------------------
+
+  -- PDatas -------------------------------------
   {-# INLINE_PDATA emptydPR #-}
   emptydPR 
         = PInts $ V.empty
@@ -142,15 +165,6 @@ instance PprPhysical (U.Array Int) where
   pprp uarr 
    =    text (show $ U.toList uarr)
 
-instance PprPhysical (PData Int) where
-  pprp (PInt uarr)
-   =    text "PInt" <+> pprp uarr
-
-instance PprPhysical (PDatas Int) where
-  pprp (PInts vecs)
-   =    text "PInts" $+$ (nest 4 $ vcat $ P.map pprp $ V.toList vecs)
-
-
 instance PprVirtual (PData Int) where
   pprv (PInt vec)
    = text (show $ U.toList vec)
index 3a266a0..a98da34 100644 (file)
@@ -83,7 +83,6 @@ instance U.Elt (Int, Int, Int)
 
 -- PR Instances ---------------------------------------------------------------
 instance PR a => PR (PArray a) where
-
   -- TODO: make this check all sub arrays as well
   -- TODO: ensure that all psegdata arrays are referenced from some psegsrc.
   -- TODO: shift segd checks into associated modules.
@@ -137,10 +136,9 @@ instance PR a => PR (PArray a) where
                 $ U.and 
                 $ U.zipWith3 
                         (\len start srcid
-                           -> let srclen = lengthPR (psegdata `indexdPR` srcid)
-                              in  and [    (len == 0 && start <= srclen)
-                                        || validIx  "nested array psegstart " srclen start
-                                      ,    validLen "nested array pseglen   " srclen (start + len)])
+                           -> let pdata = psegdata `indexdPR` srcid
+                              in  and [ coversPR (len == 0) pdata start
+                                      , coversPR True       pdata (start + len) ])
                         pseglens psegstarts psegsrcs
 
          -- Every pseg must be referenced by some vseg.
@@ -158,17 +156,33 @@ instance PR a => PR (PArray a) where
              , psegsReffedOK ]
 
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR = PNested U.emptyVSegd emptydPR
-
-
   {-# INLINE_PDATA nfPR #-}
   nfPR    = error "nfPR[PArray]: not defined yet"
 
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PNested uvsegd _)
-          = U.lengthOfVSegd uvsegd
+  {-# INLINE_PDATA similarPR #-}
+  similarPR (PArray _ pdata1) (PArray _ pdata2)
+        = V.and $ V.zipWith similarPR 
+                        (toVectorPR pdata1)
+                        (toVectorPR pdata2)
+
+
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PNested vsegd _ ) ix
+   | weak       = ix <= (U.length $ U.takeVSegidsOfVSegd vsegd)
+   | otherwise  = ix <  (U.length $ U.takeVSegidsOfVSegd vsegd)
+
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (PNested vsegd pdatas)
+        =   text "PNested"
+        $+$ ( nest 4
+            $ pprp vsegd $$ pprp pdatas)
+
+
+  -- Constructors -------------------------------
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR = PNested U.emptyVSegd emptydPR
 
 
   -- When replicating an array we use the source as the single physical
index c33fe0d..7373720 100644 (file)
@@ -33,24 +33,37 @@ nope str   = error $ "Data.Array.Parallel.PData.Sum2: no PR method for Sum2 " ++
 
 
 instance (PR a, PR b) => PR (Sum2 a b)  where
+
   {-# INLINE_PDATA validPR #-}
   validPR _
         = True
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR
-        = PSum2 (U.mkSel2 U.empty U.empty 0 0 (U.mkSelRep2 U.empty)) emptyPR emptyPR
 
   {-# INLINE_PDATA nfPR #-}
   nfPR (PSum2 sel xs ys)
         = sel `seq` nfPR xs `seq` nfPR ys `seq` ()
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PSum2 sel xs ys)
-        = U.length (U.tagsSel2 sel)
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PSum2 sel _ _) ix
+   | weak       = ix <= U.length (U.tagsSel2 sel)
+   | otherwise  = ix <  U.length (U.tagsSel2 sel)
+
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (PSum2 sel pdatas1 pdatas2)
+   =   text "PSum2"
+   $+$ (nest 4 $ vcat
+        [ pprp sel
+        , text "ALTS0: " <+> pprp pdatas1
+        , text "ALTS1: " <+> pprp pdatas2])
+
+
+  -- Constructors -------------------------------
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR
+        = PSum2 (U.mkSel2 U.empty U.empty 0 0 (U.mkSelRep2 U.empty)) emptyPR emptyPR
 
 
-  -- replicate / replicates ---------------------------------------------------
   {-# INLINE_PDATA replicatePR #-}
   replicatePR n aa
    = case aa of
@@ -69,13 +82,33 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
                           (U.mkSelRep2 (U.replicate n 1)))
                 emptyPR
                 (replicatePR n x)    
+
                 
   {-# INLINE_PDATA replicatesPR #-}
   replicatesPR
         = nope "replicates"
 
 
-  -- index / indexl -----------------------------------------------------------                      
+  {-# INLINE_PDATA appendPR #-}
+  appendPR (PSum2 sel1 as1 bs1)
+           (PSum2 sel2 as2 bs2)
+    = let !sel  = U.tagsToSel2
+                $ U.tagsSel2 sel1 U.+:+ U.tagsSel2 sel2
+      in  PSum2 sel (appendPR as1 as2)
+                    (appendPR bs1 bs2)
+        
+        
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR
+        = nope "appends"
+
+
+  -- Projections --------------------------------
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (PSum2 sel _ _)
+        = U.length $ tagsSel2 sel
+  
+  
   {-# INLINE_PDATA indexPR #-}
   indexPR (PSum2 sel as bs) i
    = let !k = U.indicesSel2 sel U.!: i
@@ -88,7 +121,7 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
         = nope "indexl"
 
 
-  -- extract / extracts -------------------------------------------------------
+  -- extract / extracts 
   -- Extract a range of elements from an array of Sum2s.
   -- Example:
   --  arr:         [L 20, R 30, L 40, R 50, R 60, R 70, L 80, R 90, L 100]
@@ -284,21 +317,7 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
            PSum2 sel' pdata0 pdata1
 
 
-  -- append / appends ---------------------------------------------------------
-  {-# INLINE_PDATA appendPR #-}
-  appendPR (PSum2 sel1 as1 bs1)
-           (PSum2 sel2 as2 bs2)
-    = let !sel  = U.tagsToSel2
-                $ U.tagsSel2 sel1 U.+:+ U.tagsSel2 sel2
-      in  PSum2 sel (appendPR as1 as2)
-                    (appendPR bs1 bs2)
-        
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR
-        = nope "appends"
-        
-
-  -- pack / combine -----------------------------------------------------------
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR
         = nope "packByTag"
@@ -308,7 +327,7 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
         = nope "combine2"
 
 
-  -- fromVector / toVector ----------------------------------------------------
+  -- Conversions --------------------------------\b
   -- TODO: fix rubbish via-lists filtering.   
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR vec
@@ -321,18 +340,20 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
         
 
   {-# INLINE_PDATA toVectorPR #-}
-  toVectorPR pdata
-   | lengthPR pdata == 0        = V.empty
-   | otherwise  
-   = V.map (indexPR pdata) 
-        $ V.enumFromTo 0 (lengthPR pdata - 1)
+  toVectorPR pdata@(PSum2 sel _ _)
+   = let len = U.length $ U.tagsSel2 sel
+     in  if len == 0
+          then V.empty
+          else V.map (indexPR pdata) 
+                $ V.enumFromTo 0 (len - 1)
 
 
-  -- PDatas -------------------------------------------------------------------
+  -- PDatas -------------------------------------
   {-# INLINE_PDATA emptydPR #-}
   emptydPR 
         = PSum2s V.empty emptydPR emptydPR emptydPR
 
+
   {-# INLINE_PDATA singletondPR #-}
   singletondPR (PSum2 sel2 xs ys)
         = PSum2s (V.singleton sel2)
@@ -340,15 +361,18 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
                  (singletondPR xs)
                  (singletondPR ys)
 
+
   {-# INLINE_PDATA lengthdPR #-}
   lengthdPR (PSum2s sel2s _ _ _)
         = V.length sel2s
 
+
   {-# INLINE_PDATA indexdPR #-}
   indexdPR  (PSum2s sel2s _ xss yss) ix
-        = PSum2 (V.unsafeIndex sel2s ix)
-                (indexdPR      xss   ix)
-                (indexdPR      yss   ix)
+        = PSum2  (V.unsafeIndex sel2s ix)
+                 (indexdPR      xss   ix)
+                 (indexdPR      yss   ix)
+
 
   {-# INLINE_PDATA appenddPR #-}
   appenddPR (PSum2s sels1 tagss1 xss1 yss1)
@@ -358,10 +382,12 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
             (xss1   `appenddPR` xss2)
             (yss1   `appenddPR` yss2)
 
+
   {-# INLINE_PDATA concatdPR #-}
   concatdPR
         = nope "concatdPR"
                 
+
   -- TODO: fix rubbish via-lists conversion.
   {-# INLINE_PDATA fromVectordPR #-}
   fromVectordPR vec
@@ -374,6 +400,7 @@ instance (PR a, PR b) => PR (Sum2 a b)  where
                    (fromVectordPR $ V.fromList pdatas1)
                    (fromVectordPR $ V.fromList pdatas2)
                 
+
   {-# INLINE_PDATA toVectordPR #-}
   toVectordPR (PSum2s sels _ pdatas1 pdatas2)
    = let  vecs1 = toVectordPR pdatas1
@@ -391,27 +418,3 @@ instance PprPhysical U.Sel2 where
        , text "INDICES:" <+> text (show $ U.toList $ U.indicesSel2 sel2)])
 
 
-instance ( PprPhysical (PData a)
-         , PprPhysical (PData b))
-        => PprPhysical (PData (Sum2 a b)) where
-
- pprp (PSum2 sel pdatas1 pdatas2)
-  =   text "PSum2"
-  $+$ (nest 4 $ vcat
-        [ pprp sel
-        , text "ALTS0: " <+> pprp pdatas1
-        , text "ALTS1: " <+> pprp pdatas2])
-
-
-instance ( PprPhysical (PDatas a)
-         , PprPhysical (PDatas b))
-        => PprPhysical (PDatas (Sum2 a b)) where
-
- pprp (PSum2s sels tagss pdatas1 pdatas2)
-  =   text "PSum2s"
-  $+$ (nest 4 $ vcat
-        [ text "SELS:"          $+$ (nest 4 $ vcat $ P.map pprp $ V.toList sels)
-        , text "PDATAS1:"       $$ (nest 4 $ pprp pdatas1)
-        , text "PDATAS2:"       $$ (nest 4 $ pprp pdatas2)])
-
-
index a6aaaee..999bee0 100644 (file)
@@ -26,120 +26,163 @@ data instance PDatas (a, b)
 
 -- PR -------------------------------------------------------------------------
 instance (PR a, PR b) => PR (a, b) where
+
   {-# INLINE_PDATA validPR #-}
   validPR (PTuple2 xs ys)
-        =  checkEq "validPR[Tuple2]" "array length mismatch" 
-                (lengthPR xs) (lengthPR ys)
-        $  validPR xs && validPR ys
+        = validPR xs && validPR ys
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR
-        = PTuple2 emptyPR emptyPR
 
   {-# INLINE_PDATA nfPR #-}
   nfPR (PTuple2 arr1 arr2)
         = nfPR arr1 `seq` nfPR arr2 `seq` ()
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PTuple2 arr1 _)
-        = lengthPR arr1
+
+  {-# INLINE_PDATA similarPR #-}
+  similarPR (x1, y1) (x2, y2)
+        =  similarPR x1 x2
+        && similarPR y1 y2
+
+
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PTuple2 arr1 arr2) ix
+        =  coversPR weak arr1 ix
+        && coversPR weak arr2 ix
+
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (PTuple2 xs ys)
+        = text "PTuple2 " <> vcat [pprpDataPR xs, pprpDataPR ys]
+
+  -- Constructors -------------------------------
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR
+        = PTuple2 emptyPR emptyPR
+
 
   {-# INLINE_PDATA replicatePR #-}
   replicatePR len (x, y)
         = PTuple2 (replicatePR len x)
                   (replicatePR len y)
 
+
   {-# INLINE_PDATA replicatesPR #-}
   replicatesPR lens (PTuple2 arr1 arr2)
         = PTuple2 (replicatesPR lens arr1)
                   (replicatesPR lens arr2)
 
+
+  {-# INLINE_PDATA appendPR #-}
+  appendPR (PTuple2 arr11 arr12) (PTuple2 arr21 arr22)
+        = PTuple2 (arr11 `appendPR` arr21)
+                  (arr12 `appendPR` arr22)
+
+
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR segdResult segd1 (PTuple2 arrs11 arrs12) segd2 (PTuple2 arrs21 arrs22)
+        = PTuple2 (appendsPR segdResult segd1 arrs11 segd2 arrs21)
+                  (appendsPR segdResult segd1 arrs12 segd2 arrs22)
+
+
+  -- Projections ---------------------------------
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (PTuple2 arr1 _) 
+        = lengthPR arr1
+  
   {-# INLINE_PDATA indexPR #-}
   indexPR (PTuple2 arr1 arr2) ix
         = (indexPR arr1 ix, indexPR arr2 ix)
 
+
   {-# INLINE_PDATA indexlPR #-}
   indexlPR (PNested uvsegd (PTuple2s xs ys)) ixs
    = let xsArr  = PNested uvsegd xs
          ysArr  = PNested uvsegd ys
      in  PTuple2  (indexlPR xsArr ixs) (indexlPR ysArr ixs)
 
+
   {-# INLINE_PDATA extractPR #-}
   extractPR (PTuple2 arr1 arr2) start len
         = PTuple2 (extractPR arr1 start len) 
                   (extractPR arr2 start len)
 
+
   {-# INLINE_PDATA extractsPR #-}
   extractsPR (PTuple2s xs ys) ussegd
    =    PTuple2  (extractsPR xs ussegd)
                  (extractsPR ys ussegd)
 
-  {-# INLINE_PDATA appendPR #-}
-  appendPR (PTuple2 arr11 arr12) (PTuple2 arr21 arr22)
-        = PTuple2 (arr11 `appendPR` arr21)
-                  (arr12 `appendPR` arr22)
-
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PTuple2 arrs11 arrs12) segd2 (PTuple2 arrs21 arrs22)
-        = PTuple2 (appendsPR segdResult segd1 arrs11 segd2 arrs21)
-                  (appendsPR segdResult segd1 arrs12 segd2 arrs22)
 
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR (PTuple2 arr1 arr2) tags tag
         = PTuple2 (packByTagPR arr1 tags tag)
                   (packByTagPR arr2 tags tag)
 
+
   {-# INLINE_PDATA combine2PR #-}
   combine2PR sel (PTuple2 xs1 ys1) (PTuple2 xs2 ys2)
         = PTuple2 (combine2PR sel xs1 xs2)
                   (combine2PR sel ys1 ys2)
 
+
+  -- Conversions --------------------------------
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR vec
    = let (xs, ys)       = V.unzip vec
      in  PTuple2 (fromVectorPR xs)
                  (fromVectorPR ys)
 
+
   {-# INLINE_PDATA toVectorPR #-}
   toVectorPR (PTuple2 xs ys)
         = V.zip  (toVectorPR xs)
                  (toVectorPR ys)
 
-  -- PRR ----------------------------------------
+
+  -- PData --------------------------------------
   {-# INLINE_PDATA emptydPR #-}
   emptydPR      
         = PTuple2s emptydPR emptydPR
+
   
   {-# INLINE_PDATA singletondPR #-}
   singletondPR (PTuple2 x y)
         = PTuple2s (singletondPR x) (singletondPR y)
 
+
   {-# INLINE_PDATA lengthdPR #-}
   lengthdPR (PTuple2s xs ys)
         = lengthdPR xs
+
    
   {-# INLINE_PDATA indexdPR #-}
   indexdPR (PTuple2s xs ys) i
         = PTuple2 (indexdPR xs i) (indexdPR ys i)
+
    
   {-# INLINE_PDATA appenddPR #-}
   appenddPR (PTuple2s xs1 ys1) (PTuple2s xs2 ys2)
         = PTuple2s (appenddPR xs1 xs2) (appenddPR ys1 ys2)
   
+
   {-# INLINE_PDATA concatdPR #-}
   concatdPR vecs
         = PTuple2s
                 (concatdPR $ V.map (\(PTuple2s xs ys) -> xs) vecs)
                 (concatdPR $ V.map (\(PTuple2s xs ys) -> ys) vecs)
 
+
   {-# INLINE_PDATA fromVectordPR #-}
   fromVectordPR vec
    = let (xss, yss) = V.unzip $ V.map (\(PTuple2 xs ys) -> (xs, ys)) vec
      in  PTuple2s (fromVectordPR xss) (fromVectordPR yss)
 
+
   {-# INLINE_PDATA toVectordPR #-}
-  toVectordPR arr
-        = error "toVectordPR[Tuple2]: not implemented"
+  toVectordPR (PTuple2s pdatas1 pdatas2)
+        = V.zipWith PTuple2
+                (toVectordPR pdatas1)
+                (toVectordPR pdatas2)
 
 
 -- PD Functions ---------------------------------------------------------------
@@ -207,12 +250,6 @@ deriving instance (Show (PData  a), Show (PData  b)) => Show (PData  (a, b))
 deriving instance (Show (PDatas a), Show (PDatas b)) => Show (PDatas (a, b))
 
 
-instance (PprPhysical (PData a), PprPhysical (PData b))
-        => PprPhysical (PData (a, b)) where
- pprp   (PTuple2 xs ys)
-        = text "PTuple2 " <> vcat [pprp xs, pprp ys]
-
-
 instance ( PR a, PR b, Show a, Show b
          , PprVirtual (PData a), PprVirtual (PData b))
         => PprVirtual (PData (a, b)) where
index 156658c..8dbfdd7 100644 (file)
@@ -15,29 +15,40 @@ data instance PData ()
         = PUnit Int
 
 data instance PDatas ()
-        = PUnits (V.Vector (PData ()))
-
-punit :: PData ()
-punit =  PUnit 0
+        = PUnits (U.Array Int)
 
+punit   :: Int -> PData ()
+punit   = PUnit
 
 -- PR -------------------------------------------------------------------------
 instance PR () where
+
   {-# INLINE_PDATA validPR #-}
   validPR _
         = True
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR
-        = PUnit 0
-
   {-# INLINE_PDATA nfPR #-}
   nfPR xx
         = xx `seq` ()
+  
+  {-# INLINE_PDATA similarPR #-}
+  similarPR _ _
+        = True
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PUnit n)
-        = n
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PUnit n) i
+   | weak       = i <= n
+   | otherwise  = i <  n
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR uu
+        = text $ show uu
+
+
+  -- Constructors -------------------------------
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR
+        = PUnit 0
 
   {-# INLINE_PDATA replicatePR #-}
   replicatePR n _
@@ -46,7 +57,21 @@ instance PR () where
   {-# INLINE_PDATA replicatesPR #-}
   replicatesPR segd _
         = PUnit (U.elementsSegd segd)
-        
+                
+  {-# INLINE_PDATA appendPR #-}
+  appendPR (PUnit len1) (PUnit len2)
+        = PUnit (len1 + len2)
+
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR segdResult _ _ _ _
+        = PUnit (U.lengthSegd segdResult)
+
+
+  -- Projections -------------------------------        
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (PUnit n)
+        = n
+
   {-# INLINE_PDATA indexPR #-}
   indexPR _ _
         = ()
@@ -62,15 +87,9 @@ instance PR () where
   {-# INLINE_PDATA extractsPR #-}
   extractsPR _ ussegd
         = PUnit (U.sum $ U.lengthsSSegd ussegd)
-                
-  {-# INLINE_PDATA appendPR #-}
-  appendPR (PUnit len1) (PUnit len2)
-        = PUnit (len1 + len2)
 
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult _ _ _ _
-        = PUnit (U.lengthSegd segdResult)
-        
+
+  -- Pack and Combine ---------------------------        
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR _ tags tag
         = PUnit (U.length $ U.filter (== tag) tags)
@@ -80,6 +99,8 @@ instance PR () where
         = PUnit ( U.elementsSel2_0 sel2
                 + U.elementsSel2_1 sel2)
 
+
+  -- Conversions --------------------------------
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR vec
         = PUnit (V.length vec)
@@ -88,14 +109,14 @@ instance PR () where
   toVectorPR (PUnit len)
         = V.replicate len ()
 
-  -----------------------------------------------
+  -- PDatas -------------------------------------
   {-# INLINE_PDATA lengthdPR #-}
   lengthdPR (PUnits pdatas)
-        = V.length pdatas
+        = U.length pdatas
         
   {-# INLINE_PDATA indexdPR #-}
   indexdPR (PUnits pdatas) ix
-        = pdatas `V.unsafeIndex` ix
+        = PUnit $ pdatas U.!: ix
         
 
 
@@ -103,10 +124,6 @@ instance PR () where
 deriving instance Show (PData  ())
 deriving instance Show (PDatas ())
 
-instance PprPhysical (PData ()) where
-  pprp uu
-   = text $ show uu
-
 instance PprVirtual (PData ()) where
   pprv (PUnit n)
    = text $ "[ () x " ++ show n ++ " ]"
index aa60e9f..62d6d9c 100644 (file)
@@ -1,7 +1,7 @@
 #include "fusion-phases.h"
 
 module Data.Array.Parallel.PArray.PData.Void 
-        (Void, pvoid, pvoids)
+        (Void, void, pvoid, fromVoid, pvoids)
 where
 import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.PArray.Types
@@ -10,9 +10,18 @@ import Data.Array.Parallel.Pretty
 import qualified Data.Vector            as V
 
 -------------------------------------------------------------------------------
--- | The Void type is used when representing enumerations. 
---   A type like Bool is represented as @Sum2 Void Void@, meaning that we only
---   only care about the tag of the data constructor and not its argumnent.
+-- | The Void type is used as a place holder in situations where we don't 
+--   want to track a real array.
+--  
+--   For example:
+--    A type like Bool is represented as @Sum2 Void Void@, meaning that we only
+--    only care about the tag of the data constructor and not its argumnent.
+--
+--    We also use it as the to fill empty closures.
+--
+--   Note that arrays of (PData Void) do not have an intrinsic length, which 
+--   is the reason that the PR dictionary only contains a coversPR function
+--   was well as a partial lengthPR function.
 --
 data instance PData Void
 
@@ -31,24 +40,44 @@ pvoids   = PVoids
 nope str    = error $ "Data.Array.Parallel.PData.Void: no PR method for " ++ str
 
 instance PR Void where
-  {-# INLINE_PDATA validPR #-}
-  validPR       = nope "valid"
 
-  {-# INLINE_PDATA emptyPR #-}
-  emptyPR       = nope "empty"
+  {-# INLINE_PDATA validPR #-}
+  validPR _       = True
 
   {-# INLINE_PDATA nfPR #-}
-  nfPR          = nope "nf"
+  nfPR _          = ()
 
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR      = nope "length"
+  {-# INLINE_PDATA similarPR #-}
+  similarPR _ _   = True
+  
+  {-# INLINE_PDATA coversPR #-}
+  coversPR _ _ _  = True
+  
+  {-# INLINE_PDATA pprpDataPR #-}
+  pprpDataPR _    = text "pvoid"
+
+
+  -- Constructors -------------------------------        
+  {-# INLINE_PDATA emptyPR #-}
+  emptyPR       = nope "emptyPR"
 
   {-# INLINE_PDATA replicatePR #-}
   replicatePR   = nope "replicate"
 
   {-# INLINE_PDATA replicatesPR #-}
   replicatesPR  = nope "replicates"
-                
+
+  {-# INLINE_PDATA appendPR #-}
+  appendPR      = nope "append"
+  
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR     = nope "appends"
+
+
+  -- Projections --------------------------------
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR _    = nope "length"
+
   {-# INLINE_PDATA indexPR #-}
   indexPR       = nope "index"
 
@@ -61,24 +90,27 @@ instance PR Void where
   {-# INLINE_PDATA extractsPR #-}
   extractsPR    = nope "extracts"
 
-  {-# INLINE_PDATA appendPR #-}
-  appendPR      = nope "append"
-  
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR     = nope "appends"
 
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR   = nope "packByTag"
 
   {-# INLINE_PDATA combine2PR #-}
   combine2PR    = nope "combine2"
 
+
+  -- Conversions --------------------------------
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR  = nope "fromVector"
 
+  -- This conversion is dodgy because it implies the array has length zero,
+  -- where really should have "no length". This is ok if we're just using
+  -- it for debugging.
   {-# INLINE_PDATA toVectorPR #-}
-  toVectorPR    = nope "toVector"
-  
+  toVectorPR _  = V.empty
+
+
+  -- PDatas -------------------------------------  
   {-# INLINE_PDATA emptydPR #-}    
   emptydPR      = PVoids 0
 
@@ -120,10 +152,6 @@ instance Show (PDatas Void) where
  show _  = "pvoids"
  
 
-instance PprPhysical (PData Void) where
-  pprp _ = text "pvoid"
-
-
 instance PprVirtual (PData Void) where
   pprv _ = text "pvoid"
 
index 1be2120..3477257 100644 (file)
@@ -22,19 +22,29 @@ instance PA a => PR (Wrap a) where
   {-# INLINE_PDATA validPR #-}
   validPR (PWrap pdata)  
         = validPA pdata
+
+  {-# INLINE_PDATA nfPR #-}
+  nfPR (PWrap pdata)      
+        = nfPA pdata
+
+  {-# INLINE_PDATA similarPR #-}
+  similarPR (Wrap x) (Wrap y)
+        = similarPA x y
+
+  {-# INLINE_PDATA coversPR #-}
+  coversPR weak (PWrap pdata) ix
+        = coversPA weak pdata ix
+
+  {-# NOINLINE pprpDataPR #-}
+  pprpDataPR (PWrap pdata)
+        = pprpDataPA pdata
+
+
+  -- Constructors -------------------------------
   {-# INLINE_PDATA emptyPR #-}
   emptyPR               
         = PWrap emptyPA
   
-  {-# INLINE_PDATA nfPR #-}
-  nfPR (PWrap pdata)      
-        = nfPA pdata
-        
-  {-# INLINE_PDATA lengthPR #-}
-  lengthPR (PWrap pdata)
-        = lengthPA pdata
-        
   {-# INLINE_PDATA replicatePR #-}
   replicatePR n (Wrap x)
         = PWrap $ replicatePA n x
@@ -43,6 +53,20 @@ instance PA a => PR (Wrap a) where
   replicatesPR segd (PWrap xs)
         = PWrap $ replicatesPA segd xs
 
+  {-# INLINE_PDATA appendPR #-}
+  appendPR (PWrap xs) (PWrap ys)
+        = PWrap $ appendPA xs ys
+        
+  {-# INLINE_PDATA appendsPR #-}
+  appendsPR segdResult segd1 (PWrap xs) segd2 (PWrap ys)
+        = PWrap $ appendsPA segdResult segd1 xs segd2 ys
+        
+
+  -- Projections --------------------------------
+  {-# INLINE_PDATA lengthPR #-}
+  lengthPR (PWrap xs)
+        = lengthPA xs
+  
   {-# INLINE_PDATA indexPR #-}
   indexPR (PWrap xs) ix
         = Wrap  $ indexPA xs ix
@@ -59,14 +83,8 @@ instance PA a => PR (Wrap a) where
   extractsPR (PWraps pdatas) ssegd
         = PWrap $ extractsPA pdatas ssegd
 
-  {-# INLINE_PDATA appendPR #-}
-  appendPR (PWrap xs) (PWrap ys)
-        = PWrap $ appendPA xs ys
-        
-  {-# INLINE_PDATA appendsPR #-}
-  appendsPR segdResult segd1 (PWrap xs) segd2 (PWrap ys)
-        = PWrap $ appendsPA segdResult segd1 xs segd2 ys
-        
+
+  -- Pack and Combine ---------------------------
   {-# INLINE_PDATA packByTagPR #-}
   packByTagPR (PWrap xs) tags tag
         = PWrap $ packByTagPA xs tags tag
@@ -75,6 +93,8 @@ instance PA a => PR (Wrap a) where
   combine2PR sel (PWrap xs) (PWrap ys)
         = PWrap $ combine2PA sel xs ys
 
+
+  -- Conversions --------------------------------
   {-# INLINE_PDATA fromVectorPR #-}
   fromVectorPR vec 
         = PWrap $ fromVectorPA $ V.map unWrap vec
@@ -83,6 +103,7 @@ instance PA a => PR (Wrap a) where
   toVectorPR (PWrap pdata)
         = V.map Wrap $ toVectorPA pdata
 
+
   -- PDatas -------------------------------------
   {-# INLINE_PDATA emptydPR #-}
   emptydPR 
@@ -103,35 +124,8 @@ instance PA a => PR (Wrap a) where
   {-# INLINE_PDATA appenddPR #-}
   appenddPR (PWraps xs) (PWraps ys)
         = PWraps $ appenddPA xs ys
-        
-{-
-  {-# INLINE_PDATA concatdPR #-}
-  concatdPR vecs
-        = PWraps
-                $ V.concat $ V.toList
-                $ V.map (\(PWraps xs) -> toVectordPA xs) vecs
--}
-{-                
-  {-# INLINE_PDATA mapdPR #-}
-  mapdPR f (PDoubles uarrs)
-        = PDoubles 
-                $ V.map (\xs -> case f (PDouble xs) of 
-                                        PDouble zs' -> zs')
-                $ uarrs
-
-  {-# INLINE_PDATA zipWithdPR #-}
-  zipWithdPR f (PDoubles uarrs1) (PDoubles uarrs2)
-        = PDoubles
-                $ V.zipWith 
-                        (\xs ys -> case f (PDouble xs) (PDouble ys) of
-                                        PDouble zs' -> zs')
-                        uarrs1 uarrs2
-                                
-  {-# INLINE_PDATA fromVectordPR #-}
-  fromVectordPR vec
-        = PDoubles $ V.map (\(PDouble xs) -> xs) vec
-        
+
   {-# INLINE_PDATA toVectordPR #-}
-  toVectordPR (PDoubles vec)
-        = V.map PDouble vec
--}
\ No newline at end of file
+  toVectordPR (PWraps pdatas)
+        = V.map PWrap $ toVectordPA pdatas
+        
index aca0045..fe387e7 100644 (file)
@@ -53,14 +53,14 @@ instance  (PprPhysical (PData (PRepr a)), PA a)
   $+$ ( nest 4 
       $ pprp $ toArrPRepr dat)
 
-
+{-
 -- | Pretty print the physical representation of a nested array
 instance (PprPhysical (PData a), PR a) 
        => PprPhysical (PData (PArray a)) where
  pprp (PNested uvsegd pdatas)
   =   text "PNested"
   $+$ (nest 4 $ pprp uvsegd $$ (pprp $ pdatas))
-
+-}
 {-
 -- | Pretty print a virtual nested array.
 instance ( PprVirtual (PData a), PR a) 
index b17d17f..cde7460 100644 (file)
@@ -1,25 +1,39 @@
 #include "fusion-phases.h"
 
 -- | Definition of the PRepr/PA family and class.
+--   PA functions are the same as the methods of the PR class, 
+--   except that they take a PA dictinoary instead of a PR 
+-- d  ictionary.
 --
 module Data.Array.Parallel.PArray.PRepr.Base 
         ( PRepr
         , PA (..)
 
-        -- PA functions are the same as the methods of the PR class, 
-        -- except that they take a PA dictinoary instead of a PR 
-        -- dictionary.
+        -- * House Keeping
         , validPA
-        , emptyPA
         , nfPA
-        , lengthPA
+        , similarPA
+        , coversPA
+        , pprpDataPA
+
+        -- * Constructors
+        , emptyPA
         , replicatePA,  replicatesPA
+        , appendPA,     appendsPA
+
+        -- * Projections
+        , lengthPA
         , indexPA,      indexlPA
         , extractPA,    extractsPA
-        , appendPA,     appendsPA
+
+        -- * Pack and Combine
         , packByTagPA
         , combine2PA
+
+        -- * Conversions 
         , fromVectorPA, toVectorPA
+
+        -- * PDatas
         , emptydPA
         , singletondPA
         , lengthdPA
@@ -28,6 +42,7 @@ module Data.Array.Parallel.PArray.PRepr.Base
         , concatdPA
         , fromVectordPA, toVectordPA)
 where
+import Data.Array.Parallel.Pretty
 import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.Base                 (Tag)
 import Data.Vector                              (Vector)
@@ -83,12 +98,6 @@ validPA arr
  = validPR (toArrPRepr arr)
 
 
-{-# INLINE_PA emptyPA #-}
-emptyPA         :: PA a => PData a
-emptyPA 
-  = fromArrPRepr emptyPR
-
-
 {-# INLINE_PA nfPA #-}
 nfPA            :: PA a => PData a -> ()
 nfPA arr
@@ -96,12 +105,30 @@ nfPA arr
  $ toArrPRepr arr
 
 
-{-# INLINE_PA lengthPA #-}
-lengthPA        :: PA a => PData a -> Int
-lengthPA arr
- = lengthPR 
- $ toArrPRepr arr
+{-# INLINE_PA similarPA #-}
+similarPA       :: PA a => a -> a -> Bool
+similarPA x y
+ = similarPR (toPRepr x) (toPRepr y)
+
+
+{-# INLINE_PA coversPA #-}
+coversPA        :: PA a => Bool -> PData a -> Int -> Bool
+coversPA weak pdata ix
+ = coversPR weak (toArrPRepr pdata) ix
+
+
+{-# INLINE_PA pprpDataPA #-}
+pprpDataPA          :: PA a => PData a -> Doc
+pprpDataPA x
+ = pprpDataPR (toArrPRepr x)
+
+
+-- Constructors ---------------------------------
+{-# INLINE_PA emptyPA #-}
+emptyPA         :: PA a => PData a
+emptyPA 
+  = fromArrPRepr emptyPR
+
 
 {-# INLINE_PA replicatePA #-}
 replicatePA     :: PA a => Int -> a -> PData a
@@ -117,6 +144,27 @@ replicatesPA segd xs
  $ replicatesPR segd (toArrPRepr xs)
 
 
+{-# INLINE_PA appendPA #-}
+appendPA        :: PA a => PData a -> PData a -> PData a
+appendPA xs ys
+ = fromArrPRepr
+ $ appendPR (toArrPRepr xs) (toArrPRepr ys)
+
+
+{-# INLINE_PA appendsPA #-}
+appendsPA       :: PA a => U.Segd -> U.Segd -> PData a -> U.Segd -> PData a -> PData a
+appendsPA segdResult segd1 xs segd2 ys
+ = fromArrPRepr
+ $ appendsPR segdResult segd1 (toArrPRepr xs) segd2 (toArrPRepr ys)
+
+
+-- Projections ----------------------------------
+{-# INLINE_PA lengthPA #-}
+lengthPA        :: PA a => PData a -> Int
+lengthPA xs
+ = lengthPR (toArrPRepr xs)
+
+
 {-# INLINE_PA indexPA #-}
 indexPA         :: PA a => PData a    -> Int -> a
 indexPA xs i
@@ -145,20 +193,7 @@ extractsPA xss segd
  $ extractsPR (toArrPReprs xss) segd
 
 
-{-# INLINE_PA appendPA #-}
-appendPA        :: PA a => PData a -> PData a -> PData a
-appendPA xs ys
- = fromArrPRepr
- $ appendPR (toArrPRepr xs) (toArrPRepr ys)
-
-
-{-# INLINE_PA appendsPA #-}
-appendsPA       :: PA a => U.Segd -> U.Segd -> PData a -> U.Segd -> PData a -> PData a
-appendsPA segdResult segd1 xs segd2 ys
- = fromArrPRepr
- $ appendsPR segdResult segd1 (toArrPRepr xs) segd2 (toArrPRepr ys)
-
-
+-- Pack and Combine -----------------------------
 {-# INLINE_PA packByTagPA #-}
 packByTagPA     :: PA a => PData a -> U.Array Tag -> Tag -> PData a
 packByTagPA xs tags tag
@@ -173,6 +208,7 @@ combine2PA sel xs ys
  $ combine2PR sel (toArrPRepr xs) (toArrPRepr ys)
  
  
+-- Conversions ----------------------------------
 {-# INLINE_PA fromVectorPA #-}
 fromVectorPA    :: PA a => Vector a -> PData a
 fromVectorPA vec
index 679d13c..5f0c731 100644 (file)
@@ -9,9 +9,9 @@ module Data.Array.Parallel.PArray.PRepr.Instances where
 import Data.Array.Parallel.PArray.Types
 import Data.Array.Parallel.PArray.PRepr.Base
 import Data.Array.Parallel.PArray.PData.Base
-import Data.Array.Parallel.PArray.PData.Void
 import Data.Array.Parallel.PArray.PData.Wrap
 import Data.Array.Parallel.PArray.PData.Unit
+import Data.Array.Parallel.PArray.PData.Void
 import Data.Array.Parallel.PArray.PData.Nested
 import Data.Array.Parallel.PArray.PData.Sum2
 import Data.Array.Parallel.PArray.PData.Tuple
@@ -35,7 +35,6 @@ instance PA Void where
   fromArrPReprs         = id
   toNestedArrPRepr      = id
 
-
 -- Unit -----------------------------------------------------------------------
 type instance PRepr () = ()
 
@@ -87,10 +86,6 @@ data instance PData Bool
 data instance PDatas Bool
   = PBools (V.Vector U.Sel2) (PDatas Tag)
 
-
-instance PprPhysical (PData Bool) where
- pprp (PBool sel2) = pprp sel2
-
 instance PA Bool where
   {-# INLINE toPRepr #-}
   toPRepr False          = Alt2_1 void
@@ -110,7 +105,9 @@ instance PA Bool where
 
   {-# INLINE toArrPReprs #-}
   toArrPReprs (PBools sels tagss)
-        = PSum2s sels tagss (pvoids (V.length sels)) (pvoids (V.length sels))
+        = PSum2s sels tagss 
+                (pvoids $ V.length sels)
+                (pvoids $ V.length sels)
 
   {-# INLINE fromArrPReprs #-}
   fromArrPReprs (PSum2s sels tagss _ _)
@@ -154,10 +151,10 @@ instance (PR a, PR b) => PA (Either a b) where
   fromArrPReprs (PSum2s sels tags pdatas1 pdatas2)
         = PEithers sels tags pdatas1 pdatas2
 
-
-instance ( PprPhysical (PData a), PR a
-         , PprPhysical (PData b), PR b)
+{-
+instance ( PprPhysical (PData a), PR a, Eq a
+         , PprPhysical (PData b), PR b, Eq b)
         => PprPhysical (PData (Either a b)) where
  pprp xs = pprp $ toArrPRepr xs
 
-
+-}
index eaaf273..2438f61 100644 (file)
@@ -48,9 +48,14 @@ module Data.Array.Parallel.Prim
         -- Tuple functions
         , tup2, tup3)
 where
-import Data.Array.Parallel.PArray.PData.Base   (PArray(..), PData, PR(..))
-import Data.Array.Parallel.PArray.PData
-        ( pvoid, punit)
+import Data.Array.Parallel.PArray.PData.Base   
+        (PArray(..), PData, PR(..))
+
+import Data.Array.Parallel.PArray.PData.Void
+        ( Void, void, pvoid, fromVoid )
+
+import Data.Array.Parallel.PArray.PData.Unit
+        ( punit )
 
 import Data.Array.Parallel.PArray.PRepr 
         ( PRepr, PA(..)
@@ -60,8 +65,7 @@ import Data.Array.Parallel.PArray.Scalar
         ( Scalar(..))
 
 import Data.Array.Parallel.PArray.Types
-        ( Void, void, fromVoid
-        , Wrap(..)
+        ( Wrap(..)
         , Sum2(..), Sum3(..))
         
 import Data.Array.Parallel.Lifted.Closure
index baf9c0a..766edfa 100644 (file)
@@ -68,7 +68,8 @@ Library
         ParallelListComp,
         PatternGuards,
         ExistentialQuantification,
-        ScopedTypeVariables
+        ScopedTypeVariables,
+        PackageImports
         
 
   GHC-Options: 
@@ -76,6 +77,7 @@ Library
         -Odph 
         -funbox-strict-fields
         -fcpr-off
+        -fno-warn-missing-instances
   
   Build-Depends:  
         base             == 4.4.*,
index aab7263..710d8b0 100644 (file)
@@ -258,10 +258,6 @@ $(testcases [ ""        <@ [t|  PArray Int |]
 
   |])
 
--- TODO: shift this to dph-base
-instance PprVirtual Bool where
- pprv = text . show
 instance (PprVirtual a, PprVirtual b) => PprVirtual (Either a b) where
  pprv (Left  x) = text "Left"  <+> pprv x
  pprv (Right y) = text "Right" <+> pprv y