Completed rewriting old parr library
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Tue, 21 Mar 2006 00:14:51 +0000 (00:14 +0000)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Tue, 21 Mar 2006 00:14:51 +0000 (00:14 +0000)
 - I have now completed adapting all of Gabi and my old code to the version
   where we simulate associated types with GADTs and changed the names as
   discussed.  The SumSq test works again.
 - Next we have to do the following:
   . Check whether everything is still optimised as well as before (including
     fusion).
   . Get the old benchmarks going.
   . Parallelise the code using gangs and distributed types.

Data/Array/Parallel/Monadic/Makefile
Data/Array/Parallel/Monadic/PAOps.hs [deleted file]
Data/Array/Parallel/Monadic/PArray.hs [deleted file]
Data/Array/Parallel/Monadic/test/sumsq/SumSq.hs
Data/Array/Parallel/Unlifted.hs [new file with mode: 0644]
Data/Array/Parallel/Unlifted/ListLike.hs [new file with mode: 0644]

index 40e6405..7f419c2 100644 (file)
@@ -76,12 +76,13 @@ CONF           = parr.conf
 
 # Files
 #
-SRCS    = ../Base/UArr.hs ../Base/BArr.hs ../Base/Debug.hs ../Base/Generics.hs\
-         ../Base/Hyperstrict.hs ../Base/Prim.hs\
+SRCS    = ../Base/Config.hs ../Base/Debug.hs\
+          ../Base/BUArr.hs ../Base/BBArr.hs\
+         ../Base/Generics.hs ../Base/Hyperstrict.hs ../Base/Prim.hs\
          UArr.hs\
          ../Declarative/Loop.hs ../Declarative/Fusion.hs\
-         PAOps.hs PArray.hs
-OBJS    = $(patsubst %.hs,%.o,$(filter %.hs,$(SRCS))) ../Base/Config/Debug.o
+         ../Unlifted/ListLike.hs ../Unlifted/NeslLike.hs ../Unlifted.hs
+OBJS    = $(patsubst %.hs,%.o,$(filter %.hs,$(SRCS)))
 LIB     = parrHS
 
 TARFILES = README TODO Makefile $(SRCS)\
@@ -91,7 +92,7 @@ TARFILES = README TODO Makefile $(SRCS)\
 
 # files that contain a `versnum = "x.y.z"' line
 #
-VERSFILE=PArray.hs
+VERSFILE=../Unlifted.hs
 
 # this is far from elegant, but extracts the plain version number
 #
@@ -225,6 +226,9 @@ test/sumsq/SumSq.hs-HCFLAGS = $(TEST_SUMSQ_HCFLAGS)
 
 test/sumsq/SumSq.o: lib$(LIB).a
 
+test/sumsq/sumsq: test/sumsq/SumSq.o
+       $(HC) -o $@ $(HCFLAGS) $^ $(HLDFLAGS)
+
 # Simple dot product test in test/dotp/
 #
 TEST_DOTP_HCFLAGS=$(BENCHFLAGS) -ddump-simpl -ddump-simpl-stats
@@ -290,6 +294,7 @@ clean:
 
 # Dependencies
 #
+# Base/
 ../Base/Config.o     : ../Base/Config.hs
 ../Base/Debug.o      : ../Base/Debug.hs ../Base/Config.hi
 ../Base/Prim.o       : ../Base/Prim.hs
@@ -297,9 +302,17 @@ clean:
 ../Base/Generics.o   : ../Base/Generics.hs ../Base/Hyperstrict.hi
 ../Base/BUArr.o      : ../Base/BUArr.hs ../Base/Debug.hi
 ../Base/BBArr.o      : ../Base/BBArr.hs ../Base/Debug.hi
+# Monadic/
 UArr.o    : UArr.hs ../Base/BUArr.hi ../Base/Generics.hi ../Base/Prim.hi
+# Declarative/
 ../Declarative/Loop.o  : ../Declarative/Loop.hs UArr.hi
 ../Declarative/Fusion.o: ../Declarative/Fusion.hs ../Declarative/Loop.hi\
                         UArr.hi
-PAOps.o   : PAOps.hs PAFusion.hi ../Declarative/Loop.hi UArr.hi
-PArray.o  : PArray.hs PAOps.hi UArr.hi
+# Unlifted/
+../Unlifted/ListLike.o: ../Unlifted/ListLike.hs ../Declarative/Fusion.hi\
+                        ../Declarative/Loop.hi UArr.hi
+../Unlifted/NeslLike.o: ../Unlifted/NeslLike.hs ../Unlifted/ListLike.hi\
+                       ../Declarative/Fusion.hi ../Declarative/Loop.hi UArr.hi
+# Public interface
+../Unlifted.o: ../Unlifted.hs ../Unlifted/ListLike.hi ../Unlifted/NeslLike.hi\
+              UArr.hi
diff --git a/Data/Array/Parallel/Monadic/PAOps.hs b/Data/Array/Parallel/Monadic/PAOps.hs
deleted file mode 100644 (file)
index e06791e..0000000
+++ /dev/null
@@ -1,523 +0,0 @@
--- |Loop-based combinators
---
---  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
---
---  $Id: PAOps.hs,v 1.14 2002/12/02 07:42:40 chak Exp $
---
---  This file may be used, modified, and distributed under the same conditions
---  and the same warranty disclaimer as set out in the X11 license.
---
---- Description ---------------------------------------------------------------
---
---  Language: Haskell 98 + multi-parameter classes
---
---  Parallel array versions of the combinators that are either commonly used
---  with lists or in Nesl-style languages.
---
---- Todo ----------------------------------------------------------------------
---
-
-module PAOps (
-  -- * List-like combinators
-  mapP,        (+:+), filterP, concatP, {-concatMapP,-} nullP, (!:), foldlP, foldlSP,
-  {-foldl1P,-} scanlP, {-scanl1P, foldrP, foldr1P, scanrP, scanr1P,-}
-  foldP, foldSP, {-fold1P, fold1SP,-} scanP, {-scanSP, scan1P, scan1SP,-}
-  takeP, dropP,        splitAtP, {-takeWhileP, dropWhileP, spanP, breakP,-}
---  lines, words, unlines, unwords,  -- is string processing really needed
-  reverseP, andP, andSP, orP, orSP, anyP, allP, elemP, notElemP, {-lookupP,-}
-  sumP, sumSP, productP, productSP, maximumP, maximumSP, minimumP, minimumSP, 
-  zipP, zip3P, zipWithP, zipWith3P, unzipP, unzip3P, enumFromToP,
-  enumFromToSP, enumFromThenToP, enumFromThenToSP, 
-
-  -- * Array-oriented combinators
-  --
-  flattenP, (>:), segmentP, toP, toSP, fromP, emptyP, 
-  permuteP, bpermuteP, bpermuteSP, bpermuteDftP, {-crossP, indexOfP -}
-) where
-
--- GHC-specific libraries
-import Data.Generics
-
--- friends
-import Data.Array.Parallel.Base.UArr  (indexU, runST)
-import PABase    (PArray, FArray, PArr, SPArr, PAProd, PArrBool, PArrInt,
-                 SPArrInt, SPArrBool, UInt,
-                 lengthP, toSegd, sliceP, newMP, newMSP, writeMP, nextMSP,
-                 unsafeFreezeMP, psumS) 
-import qualified
-       PABase    (zipP, unzipP)
-import PALoop    (loopArr, loopArrS, loopAcc, loopAccS, loopSndAcc)
-import PAEP      (EP(..), indexP, (>:), flattenP, replicateP, loopP,
-                 replicateSP, loopSP)
-import PAFusion  (noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL,
-                 transSFL, keepSFL)
-
-
-infixl 9 !:
-infixr 5 +:+
-infix  4 `elemP`, `notElemP`
-
-
--- |List-like combinators
--- ----------------------
-
--- |Map a function over an array
---
-mapP :: (EP e r, PArray r arr, EP e' r', FArray r' arr')
-     => (e -> e') -> PArr arr e -> PArr arr' e'
-{-# INLINE mapP #-}
-mapP f = loopArr . loopP (mapEFL f) noAL
-
--- |Concatenate two arrays
---
-(+:+) :: (EP e r, FArray r arr)
-      => PArr arr e -> PArr arr e -> PArr arr e
-{-# INLINE (+:+) #-}
-a1 +:+ a2 = loopArr $ loopP extract 0 (replicateP len noAL)
-  where
-    len1 = lengthP a1
-    len  = len1 + lengthP a2
-    --
-    extract i _ = (i + 1, Just $ if i < len1 then a1!:i else a2!:(i - len1))
-
--- |Extract all elements from an array that meet the given predicate
---
-filterP :: (EP e r, FArray r arr) 
-       => (e -> Bool) -> PArr arr e -> PArr arr e 
-{-# INLINE filterP #-}
-filterP p  = loopArr . loopP (filterEFL p) noAL
-
--- |Concatenate the subarrays of an array of arrays
---
-concatP :: PArray r arr => SPArr arr e -> PArr arr e
-concatP = snd . flattenP
-
--- |Test whether the given array is empty
---
-nullP :: PArray r arr => PArr arr e -> Bool
-nullP  = (== 0) . lengthP
-
--- |Yield an empty array
---
-emptyP :: FArray r arr => PArr arr e
-emptyP = runST (do
-          mpa <- newMP 0
-          unsafeFreezeMP mpa 0
-         )
-
--- |Array indexing
---
-(!:) :: (EP e r, PArray r arr) 
-     => PArr arr e -> Int -> e
-(!:) = indexP
-
--- |Array reduction proceeding from the left
---
-foldlP :: (EP a r, PArray r arr) => (b -> a -> b) -> b -> PArr arr a -> b
-{-# INLINE foldlP #-}
-foldlP f z = loopAcc . loopP (foldEFL f) z
-
--- |Array reduction that requires an associative combination function with its
--- unit
---
-foldP :: (EP a r, PArray r arr) => (a -> a -> a) -> a -> PArr arr a -> a
-foldP = foldlP
-
--- |Segmented array reduction proceeding from the left
---
-foldlSP :: (EP a ra, PArray ra arra, EP b rb, FArray rb arrb)
-       => (b -> a -> b) -> b -> SPArr arra a -> PArr arrb b
-{-# INLINE foldlSP #-}
-foldlSP f z = loopAccS . loopSP (foldEFL f) (keepSFL (const z)) z
-
--- |Segmented array reduction that requires an associative combination
--- function with its unit
---
-foldSP :: (EP a r, FArray r arr) 
-       => (a -> a -> a) -> a -> SPArr arr a -> PArr arr a
-foldSP = foldlSP
-
--- |Prefix scan proceedings from left to right
---
-scanlP :: (EP a ar, PArray ar aarr, EP b br, FArray br barr) 
-       => (b -> a -> b) -> b -> PArr aarr a -> PArr barr b
-{-# INLINE scanlP #-}
-scanlP f z = loopArr . loopP (scanEFL f) z
-
--- |Prefix scan proceedings from left to right that needs an associative
--- combination function with its unit
---
-scanP :: (EP a r, FArray r arr) 
-      => (a -> a -> a) -> a -> PArr arr a -> PArr arr a
-scanP = scanlP
-
--- |Extract a prefix of an array
---
-takeP :: PArray r arr
-      => Int -> PArr arr e -> PArr arr e
-{-# INLINE takeP #-}
-takeP n a = sliceP a 0 n
-
--- |Extract a suffix of an array
---
-dropP :: PArray r arr
-      => Int -> PArr arr e -> PArr arr e
-{-# INLINE dropP #-}
-dropP n a = let len = lengthP a 
-           in
-           sliceP a n (len - n)
-
--- |Split an array into two halves at the given index
---
-splitAtP :: PArray r arr
-         => Int -> PArr arr e -> (PArr arr e, PArr arr e)
-{-# INLINE splitAtP #-}
-splitAtP n a = (takeP n a, dropP n a)
-
--- |Reverse the order of elements in an array
---
-reverseP :: (EP e r, FArray r arr)
-        => PArr arr e -> PArr arr e
-reverseP a = loopArr $ loopP extract (len - 1) (replicateP len noAL)
-            where
-              len = lengthP a
-              --
-              extract i _ = (i - 1, Just $ a!:i)
-
--- |
-andP :: PArrBool -> Bool
-andP = foldP (&&) True
-
--- |
-andSP :: SPArrBool -> PArrBool
-andSP = foldSP (&&) True
-
--- |
-orP :: PArrBool -> Bool
-orP = foldP (||) False
-
--- |
-orSP :: SPArrBool -> PArrBool
-orSP = foldSP (||) False
-
--- |
-allP :: (EP e r, PArray r arr) 
-     => (e -> Bool) -> PArr arr e -> Bool
-{-# INLINE allP #-}
-allP p = andP . mapP p
-
--- |
-anyP :: (EP e r, PArray r arr) 
-     => (e -> Bool) -> PArr arr e -> Bool
-{-# INLINE anyP #-}
-anyP p =  orP . mapP p
-
--- |Determine whether the given element is in an array
---
-elemP :: (Eq e, EP e r, PArray r arr) 
-      => e -> PArr arr e -> Bool
-elemP e = anyP (== e)
-
--- |Negation of `elemP'
---
-notElemP :: (Eq e, EP e r, PArray r arr) 
-        => e -> PArr arr e -> Bool
-notElemP e = allP (/= e)
-
--- |Compute the sum of an array of numerals
---
-sumP :: (Num e, EP e r, PArray r arr) => PArr arr e -> e
-{-# INLINE sumP #-}
-sumP = foldP (+) 0
-
--- |Compute the segmented sum of an array of numerals
---
-sumSP :: (Num e, EP e r, FArray r arr) => SPArr arr e -> PArr arr e
-{-# INLINE sumSP #-}
-sumSP = foldSP (+) 0
-
--- |Compute the product of an array of numerals
---
-productP :: (Num e, EP e r, PArray r arr) => PArr arr e -> e
-{-# INLINE productP #-}
-productP = foldP (*) 0
-
--- |Compute the segmented product of an array of numerals
---
-productSP :: (Num e, EP e r, FArray r arr) => SPArr arr e -> PArr arr e
-{-# INLINE productSP #-}
---productSP  = foldSP (*) 0
-productSP  = undefined
---FIXME
-
--- |Determine the maximum element in an array
---
-maximumP :: (Bounded e, Ord e, EP e r, PArray r arr) 
-         => PArr arr e -> e
---FIXME: provisional
---maximumP :: (Ord e, EP e r, PArray r arr) => PArr arr -> e
-{-# INLINE maximumP #-}
---maximumP = fold1P max
-maximumP = foldP max (minBound)
-
--- |Determine the maximum element in each subarray
---
-maximumSP :: (Bounded e, Ord e, EP e r, FArray r arr) 
-          => SPArr arr e -> PArr arr e
---FIXME: provisional
---maximumSP :: (Ord e, EP e r, PArray r arr) => SPArr arr -> PArr arr
-{-# INLINE maximumSP #-}
---maximumSP = fold1SP max
-maximumSP = foldSP max minBound
-
--- |Determine the minimum element in an array
---
-minimumP :: (Bounded e, Ord e, EP e r, PArray r arr) 
-        => PArr arr e -> e
---FIXME: provisional
---minimumP :: (Ord e, EP e r, PArray r arr) => PArr arr -> e
-{-# INLINE minimumP #-}
---minimumP = fold1P min
-minimumP = foldP min maxBound
-
--- |Determine the minimum element in each subarray
---
-minimumSP :: (Bounded e, Ord e, EP e r, FArray r arr) 
-         => SPArr arr e -> PArr arr e
---FIXME: provisional
---minimumSP :: (Ord e, EP e r, PArray r arr) => SPArr arr -> PArr arr
-{-# INLINE minimumSP #-}
---minimumSP = fold1SP min
-minimumSP = foldSP min maxBound
-
--- |
-zipP :: (PArray r1 arr1, PArray r2 arr2) 
-     => PArr arr1 e1 -> PArr arr2 e2 -> PArr (PAProd arr1 arr2) (e1, e2)
-zipP = PABase.zipP
-
--- |
-zip3P :: (PArray r1 arr1, PArray r2 arr2, PArray r3 arr3) 
-      => PArr arr1 e1 -> PArr arr2 e2 -> PArr arr3 e3
-      -> PArr (PAProd (PAProd arr1 arr2) arr3) (e1, e2, e3)
-{-# INLINE zip3P #-}
-zip3P a1 a2 a3 = (a1 `PABase.zipP` a2) `PABase.zipP` a3
-
--- |
-zipWithP :: (EP a ra, PArray ra arra, 
-            EP b rb, PArray rb arrb, 
-            EP c rc, FArray rc arrc)
-         => (a -> b -> c) -> PArr arra a -> PArr arrb b -> PArr arrc c
-{-# INLINE zipWithP #-}
-zipWithP f a1 a2 = loopArr $ loopP (mapEFL (uncurry f)) noAL (zipP a1 a2)
-
--- |
-zipWith3P :: (EP a ra, PArray ra arra, 
-             EP b rb, PArray rb arrb, 
-             EP c rc, PArray rc arrc,
-             EP d rd, FArray rd arrd)
-          => (a -> b -> c -> d) 
-         -> PArr arra a -> PArr arrb b -> PArr arrc c -> PArr arrd d
-{-# INLINE zipWith3P #-}
-zipWith3P f a1 a2 a3 = 
-  loopArr $ loopP (mapEFL (\(x, y, z) -> f x y z)) noAL (zip3P a1 a2 a3)
-
--- |
-unzipP :: (PArray r1 arr1, PArray r2 arr2) 
-       => PArr (PAProd arr1 arr2) (e1, e2) -> (PArr arr1 e1, PArr arr2 e2)
-unzipP = PABase.unzipP
-
--- |
-unzip3P :: (PArray r1 arr1, PArray r2 arr2, PArray r3 arr3) 
-        => PArr (PAProd (PAProd arr1 arr2) arr3) (e1, e2, e3)
-        -> (PArr arr1 e1, PArr arr2 e2, PArr arr3 e3)
-{-# INLINE unzip3P #-}
-unzip3P a = let (a12, a3) = PABase.unzipP a
-               (a1 , a2) = PABase.unzipP a12
-           in
-           (a1, a2, a3)
-
-
--- |Enumeration functions
--- ----------------------
-
--- |Yield an enumerated array
---
-enumFromToP :: (Enum e, EP e r, FArray r arr)
-           => e -> e -> PArr arr e
-{-# INLINE enumFromToP #-}
-enumFromToP start = enumFromThenToP start (succ start)
-
--- |Yield a segmented enumerated array
---
-enumFromToSP :: (Enum e, EP e r, FArray r arr)
-            => PArr arr e -> PArr arr e -> SPArr arr e
-{-# INLINE enumFromToSP #-}
-enumFromToSP starts = enumFromThenToSP starts (mapP succ starts)
-
--- |Yield an enumerated array using a specific step
---
-enumFromThenToP :: (Enum e, EP e r, FArray r arr)
-               => e -> e -> e -> PArr arr e
-{-# INLINE enumFromThenToP #-}
-enumFromThenToP start next end = 
-  loopArr $ loopP step start' (replicateP len noAL)
-  where
-    start' = fromEnum start
-    next'  = fromEnum next
-    end'   = fromEnum end
-    delta  = next' - start'
-    len    = abs (end' - start' + delta) `div` (abs delta)
-    --
-    step x _ = (x + delta, Just $ toEnum x)
-
--- |Yield a segmented enumerated array using a specific step
---
-enumFromThenToSP :: (Enum e, EP e r, FArray r arr)
-                => PArr arr e -> PArr arr e -> PArr arr e -> SPArr arr e
-{-# INLINE enumFromThenToSP #-}
-enumFromThenToSP starts nexts ends = 
-  loopArrS $ loopSP step seg init (segd >: replicateP len Unit)
-  where
-    lens    = zipWith3P calcLen starts nexts ends
-             where
-               calcLen start next end = 
-                 abs (end' - start' + delta) `div` (abs delta)
-                 where
-                   start' = fromEnum start
-                   next'  = fromEnum next
-                   end'   = fromEnum end
-                   delta  = next' - start'
-    len     = sumP    lens
-    segd    = toSegd  lens
-    segdlen = lengthP lens
-    --
-    step (x, delta) _ = ((x + delta, delta), Just $ toEnum x)
-    seg  _          i = ((start, delta), Nothing::Maybe Unit)
-                       where
-                         start = fromEnum (starts!:(i + 1))
-                         next  = fromEnum (nexts !:(i + 1))
-                         delta = if (i + 1) == segdlen 
-                                 then 0 
-                                 else next - start
-    --
-    init = fst $ seg undefined (-1)
-
-
--- |Segmentation
--- -------------
-
--- |Segment an array according to the given vector of segment lengths
---
--- FIXME: Change this to the type used in the lecture notes?  To pass around a
---   segd without any array structure attached, we could always pass a
---   properly segmented unit array.
-segmentP :: PArray r arr => PArrInt -> PArr arr e -> SPArr arr e
-{-# INLINE segmentP #-}
-segmentP lens arr = toSegd lens >: arr
-
-
--- |Conversion
--- -----------
-
--- |Turn a list into a parallel array
---
-toP :: (EP e r, FArray r arr) => [e] -> PArr arr e
-{-# INLINE toP #-}
-toP l = 
-  loopArr $ 
-    loopP (\(x:xs) (_::Unit) -> (xs, Just $ x)) l (replicateP (length l) noAL)
-
--- |Turn a nested list into a segmented parallel array
---
-toSP :: (EP e r, FArray r arr) => [[e]] -> SPArr arr e
-{-# INLINE toSP #-}
-toSP ls = let lens = toP $ map length ls
-             a    = toP $ concat ls
-          in
-         lens `segmentP` a
-
--- |Collect the elements of a parallel array in a list
---
-fromP :: (EP e r, PArray r arr) => PArr arr e -> [e]
-{-# INLINE fromP #-}
-fromP a = [a!:i | i <- [0..lengthP a - 1]]
-
-
--- |Permutations
--- -------------
-
--- |Standard permutation
---
-permuteP :: (EP e r, FArray r arr) => PArr arr e -> PArrInt -> PArr arr e
-{-# INLINE permuteP #-}
-permuteP arr is = 
-  runST (do
-    mpa <- newMP n
-    permute0 mpa
-    unsafeFreezeMP mpa n
-  )
-  where
-    n           = lengthP arr
-    permute0 mpa = permute 0
-      where
-        permute i 
-         | i == n    = return ()
-         | otherwise = writeMP mpa (is!:i) (from (arr!:i)) >> permute (i + 1)
-
--- |Back permutation operation (ie, the permutation vector determines for each
--- position in the result array its origin in the input array)
---
-bpermuteP :: (EP e r, FArray r arr) => PArr arr e -> PArrInt -> PArr arr e
-{-# INLINE bpermuteP #-}
-bpermuteP a = loopArr . loopP (mapEFL (a !:)) noAL
-
--- |Segmented back permute
---
-bpermuteSP :: (EP e r, FArray r arr) => SPArr arr e -> SPArrInt -> SPArr arr e
-{-# INLINE bpermuteSP #-}
-bpermuteSP as = loopArrS . loopSP extract nextOff 0
-               where
-                 (segd, a) = flattenP as
-                 psum      = psumS segd
-                 --
-                 extract off i = (off, Just $ a!:(off + i))
-                 --
-                 nextOff _ segi = (psum `indexU` (segi + 1), 
-                                   Nothing::Maybe Unit)
-
--- |Default back permute
---
--- * The values of the index-value pairs are written into the position in the
---   result array that is indicated by the corresponding index.
---
--- * All positions not covered by the index-value pairs will have the value
---   determined by the initialiser function for that index position.
---
-bpermuteDftP :: (EP e r, FArray r arr)
-            => Int                             -- length of result array
-            -> (Int -> e)                      -- initialiser function
-            -> PArr (PAProd UInt arr) (Int, e) -- index-value pairs
-            -> PArr arr e
-{-# INLINE bpermuteDftP #-}
-bpermuteDftP n init arr =
-  runST (do
-    mpa <- newMP n
-    doInit0  mpa
-    permute0 mpa
-    unsafeFreezeMP mpa n
-  )
-  where
-    doInit0 mpa = doInit 0
-      where
-        doInit i | i == n    = return ()
-                | otherwise = writeMP mpa i (from $ init i) >> doInit (i + 1)
-    --
-    m           = lengthP arr
-    permute0 mpa = permute 0
-      where
-        permute i 
-         | i == m    = return ()
-         | otherwise = do
-                         let (j, e) = arr!:i
-                         writeMP mpa j (from e)
-                         permute (i + 1)
diff --git a/Data/Array/Parallel/Monadic/PArray.hs b/Data/Array/Parallel/Monadic/PArray.hs
deleted file mode 100644 (file)
index 14c6efd..0000000
+++ /dev/null
@@ -1,97 +0,0 @@
--- |External interface to the parallel arrays library
---
---  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
---
---  $Id: PArray.hs,v 1.20 2003/03/13 05:24:44 chak Exp $
---
---  This file may be used, modified, and distributed under the same conditions
---  and the same warranty disclaimer as set out in the X11 license.
---
---- Description ---------------------------------------------------------------
---
---  Language: Haskell 98
---
---- Todo ----------------------------------------------------------------------
---
-
-module PArray (
-  -- * Classes
-  EP, PArray,
-
-  -- * Types
-  PArr, SPArr, PAUnit, PAProd, PAPrimU, PAPArr, UInt, UChar, UFloat, UDouble,
-  PArrBool, PArrChar, PArrInt, PArrFloat, PArrDouble, SPArrBool, SPArrChar,
-  SPArrInt, SPArrFloat, SPArrDouble, PSegd,
-
-  -- * Combinators imitating basic list processing functions
-  mapP,        (+:+), filterP, concatP, {-concatMapP,-} nullP, lengthP, (!:), foldlP,
-  foldlSP, {-foldl1P,-} scanlP, {-scanl1P, foldrP, foldr1P, scanrP, scanr1P,-}
-  foldP, foldSP, {-fold1P, fold1SP,-} scanP, {-scanSP, scan1P, scan1SP,-}
-  takeP, dropP,        splitAtP, {-takeWhileP, dropWhileP, spanP, breakP,-}
---  lines, words, unlines, unwords,  -- is string processing really needed
-  reverseP, andP, andSP, orP, orSP, anyP, allP, elemP, notElemP, {-lookupP,-}
-  sumP, sumSP, productP, productSP, maximumP, maximumSP, minimumP, minimumSP,
-  zipP, zip3P, zipWithP, zipWith3P, unzipP, unzip3P, enumFromToP,
-  enumFromToSP, enumFromThenToP, enumFromThenToSP, 
-
-  -- * Array-oriented combinators
-  --
-  flattenP, (>:), toSegd, fromSegd, segmentP, toP, toSP, fromP, emptyP, sliceP,
-  permuteP, bpermuteP, bpermuteSP, bpermuteDftP, {-crossP, indexOfP, -}
-
-  -- * Loop/replicate combinators
-  replicateP, loopP, replicateSP, loopSP,
-
-  -- * Projection combinators for loops
-  loopArr, loopArrS, loopAcc, loopAccS, loopSndAcc,
-
-  -- * Special forms of loop mutators
-  noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL, transSFL, keepSFL,
-
-  -- * Library id
-  idstr, name, versnum, date, version, copyright, disclaimer
-) where
-
-import PABase   (PArray, PArr, SPArr, PAUnit, PAProd, PAPrimU, PAPArr, UInt,
-                UChar, UFloat, UDouble, PArrChar, PArrInt, PArrFloat,
-                PArrDouble, SPArrChar, SPArrInt, SPArrFloat, SPArrDouble,
-                PSegd, toSegd, fromSegd) 
-import PALoop   (loopArr, loopArrS, loopAcc, loopAccS, loopSndAcc)
-import PAEP     (EP, lengthP, sliceP, replicateP, loopP, replicateSP, loopSP)
-import PAFusion
-import PAOps
-
-
--- version number is major.minor.patchlvl; don't change the format of the
--- `versnum' line as it is `grep'ed for by a Makefile
---
-idstr      = "$Id: PArray.hs,v 1.20 2003/03/13 05:24:44 chak Exp $"
-name       = "Parallel Array Library"
-versnum    = "0.4.1"
-date      = "13 Mar 2003"
-version    = name ++ ", version " ++ versnum ++ ", " ++ date
-copyright  = "Copyright (c) [2001..2003] \
-            \Manuel M T Chakravarty & Gabriele Keller"
-disclaimer = "This software is distributed under the terms \
-            \of the X11 license.  NO WARRANTY WHATSOEVER IS PROVIDED. \
-            \See the details in the documentation."
-
-
--- |Parallel array instances of standard classes
--- ---------------------------------------------
-
--- |
-instance (Show e, EP e r, PArray r arr) => Show (PArr arr e) where
-  showsPrec _  = (showString "toP " .) . showList . fromP
-
--- |
-instance Show PSegd where
-  showsPrec _ segd =   showString "toSegd (toP "
-                    . showList (fromP (fromSegd segd))
-                    . showChar ')'
-
--- |
-instance (Eq e, EP e r, PArray r arr) => Eq (PArr arr e) where
-  a1 == a2 = foldlP cmp True (zipP a1 a2)
-            where
-              cmp r (e1, e2) = e1 == e2 && r
index 2929ad2..ee1932a 100644 (file)
@@ -1,11 +1,14 @@
 -- the infamous sum square fusion example
 
-module SumSq (sumSq)
+module Main (main)
 where
 
-import PArray
+import Data.Array.Parallel.Unlifted
 
 sumSq :: Int -> Int
 {-# NOINLINE sumSq #-}
 --sumSq = sumP . mapP (\x -> x * x) . enumFromToP 1
-sumSq n = sumP (mapP (\x -> x * x) (enumFromToP 1 n))
+sumSq n = sumU (mapU (\x -> x * x) (enumFromToU 1 n))
+
+main = print $ sumSq 100
+
diff --git a/Data/Array/Parallel/Unlifted.hs b/Data/Array/Parallel/Unlifted.hs
new file mode 100644 (file)
index 0000000..75ea98b
--- /dev/null
@@ -0,0 +1,99 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Data.Array.Parallel.Unlifted
+-- Copyright   : (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
+--              (c) 2006         Manuel M T Chakravarty
+-- License     : see libraries/base/LICENSE
+-- 
+-- Maintainer  : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
+-- Stability   : experimental
+-- Portability : portable
+--
+-- Description ---------------------------------------------------------------
+--
+-- External interface to unlifted arrays.
+--
+-- Todo ----------------------------------------------------------------------
+--
+
+module Data.Array.Parallel.Unlifted (
+  -- * Classes
+  UA, MUA,
+
+  -- * Types
+  UArr, USegd,
+
+  -- * List-like combinators
+  mapU,        (+:+), filterU, concatU, {-concatMapU,-} nullU, lengthU, (!:), foldlU,
+  foldlSU, {-foldl1U,-} scanlU, {-scanl1U, foldrU, foldr1U, scanrU, scanr1U,-}
+  foldU, foldSU, {-fold1U, fold1SU,-} scanU, {-scanSU, scan1U, scan1SU,-}
+  takeU, dropU,        splitAtU, {-takeWhileU, dropWhileU, spanU, breakU,-}
+--  lines, words, unlines, unwords,  -- is string processing really needed
+  reverseU, andU, andSU, orU, orSU, anyU, allU, elemU, notElemU, {-lookupU,-}
+  sumU, sumSU, productU, productSU, maximumU, maximumSU, minimumU, minimumSU,
+  zipU, zip3U, zipWithU, zipWith3U, unzipU, unzip3U, enumFromToU,
+  enumFromToSU, enumFromThenToU, enumFromThenToSU, 
+
+  -- * Nesl-like combinators
+  --
+  flattenU, (>:), toUSegd, fromUSegd, segmentU, toU, toSU, fromU, emptyU,
+  sliceU, permuteU, bpermuteU, bpermuteSU, bpermuteDftU, {-crossU, indexOfU, -}
+
+  -- * Loop/replicate combinators
+  replicateU, loopU, replicateSU, loopSU,
+
+  -- * Projection combinators for loops
+  loopArr, loopArrS, loopAcc, loopAccS, loopSndAcc,
+
+  -- * Special forms of loop mutators
+  noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL, transSFL, keepSFL,
+
+  -- * Library id
+  idstr, name, versnum, date, version, copyright, disclaimer
+) where
+
+import Data.Array.Parallel.Base.Generics
+import Data.Array.Parallel.Monadic.UArr (
+  UA, MUA, UArr, USegd, fromUSegd, toUSegd)
+import Data.Array.Parallel.Declarative.Loop (
+  replicateU, loopU, replicateSU, loopSU, loopArr, loopArrS, loopAcc,
+  loopAccS, loopSndAcc)
+import Data.Array.Parallel.Declarative.Fusion (
+  noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL, transSFL, keepSFL)
+import Data.Array.Parallel.Unlifted.ListLike
+import Data.Array.Parallel.Unlifted.NeslLike
+
+
+-- version number is major.minor.patchlvl; don't change the format of the
+-- `versnum' line as it is `grep'ed for by a Makefile
+--
+idstr      = "$Id: FIXME: Have the build-system produce an id$"
+name       = "Unlifted Array Library"
+versnum    = "0.5.0"
+date      = "20 Mar 2006"
+version    = name ++ ", version " ++ versnum ++ ", " ++ date
+copyright  = "Copyright (c) [2001..2003] \
+            \M M T Chakravarty, G Keller & R Leshchinskiy"
+disclaimer = "This software is distributed under the terms \
+            \of the X11 license.  NO WARRANTY WHATSOEVER IS PROVIDED. \
+            \See the details in the documentation."
+
+
+-- |Parallel array instances of standard classes
+-- ---------------------------------------------
+
+-- |
+instance (Show e, UA e) => Show (UArr e) where
+  showsPrec _  = (showString "toU " .) . showList . fromU
+
+-- |
+instance Show USegd where
+  showsPrec _ segd =   showString "toUSegd (toU "
+                    . showList (fromU (fromUSegd segd))
+                    . showChar ')'
+
+-- |
+instance (Eq e, UA e) => Eq (UArr e) where
+  a1 == a2 = foldlU cmp True (zipU a1 a2)
+            where
+              cmp r (e1 :*: e2) = e1 == e2 && r
diff --git a/Data/Array/Parallel/Unlifted/ListLike.hs b/Data/Array/Parallel/Unlifted/ListLike.hs
new file mode 100644 (file)
index 0000000..7ba7301
--- /dev/null
@@ -0,0 +1,350 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Data.Array.Parallel.Unlifted.ListLike
+-- Copyright   : (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
+--              (c) 2006         Manuel M T Chakravarty
+-- License     : see libraries/base/LICENSE
+-- 
+-- Maintainer  : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
+-- Stability   : internal
+-- Portability : portable
+--
+-- Description ---------------------------------------------------------------
+--
+--  Unlifted array versions of list-like combinators.
+--
+-- Todo ----------------------------------------------------------------------
+--
+
+module Data.Array.Parallel.Unlifted.ListLike (
+  -- * List-like combinators
+  mapU,        (+:+), filterU, concatU, {-concatMapU,-} nullU, lengthU, (!:), foldlU,
+  foldlSU, {-foldl1U,-} scanlU, {-scanl1U, foldrU, foldr1U, scanrU, scanr1U,-}
+  foldU, foldSU, {-fold1U, fold1SU,-} scanU, {-scanSU, scan1U, scan1SU,-}
+  replicateU,
+  takeU, dropU,        splitAtU, {-takeWhileU, dropWhileU, spanU, breakU,-}
+--  lines, words, unlines, unwords,  -- is string processing really needed
+  reverseU, andU, andSU, orU, orSU, anyU, allU, elemU, notElemU, {-lookupU,-}
+  sumU, sumSU, productU, productSU, maximumU, maximumSU, minimumU, minimumSU, 
+  zipU, zip3U, zipWithU, zipWith3U, unzipU, unzip3U, enumFromToU,
+  enumFromToSU, enumFromThenToU, enumFromThenToSU, 
+) where
+
+-- friends
+import Data.Array.Parallel.Base.Generics
+import Data.Array.Parallel.Base.BUArr (
+  indexBU, runST)
+import Data.Array.Parallel.Monadic.UArr (
+  UA, MUA, UArr, lengthU, indexU, toUSegd, sliceU, newMU, writeMU,
+  unsafeFreezeMU, (>:), flattenU, zipU, unzipU)
+import Data.Array.Parallel.Declarative.Loop (
+  replicateU, loopU, replicateSU, loopSU,
+  loopArr, loopArrS, loopAcc, loopAccS, loopSndAcc)
+import Data.Array.Parallel.Declarative.Fusion (
+  noEFL, noSFL, noAL, mapEFL, filterEFL, foldEFL, scanEFL, transSFL, keepSFL)
+
+
+infixl 9 !:
+infixr 5 +:+
+infix  4 `elemU`, `notElemU`
+
+
+-- |List-like combinators
+-- ----------------------
+
+-- |Map a function over an array
+--
+mapU :: (UA e, MUA e') => (e -> e') -> UArr e -> UArr e'
+{-# INLINE mapU #-}
+mapU f = loopArr . loopU (mapEFL f) noAL
+
+-- |Concatenate two arrays
+--
+(+:+) :: MUA e => UArr e -> UArr e -> UArr e
+{-# INLINE (+:+) #-}
+a1 +:+ a2 = loopArr $ loopU extract 0 (replicateU len noAL)
+  where
+    len1 = lengthU a1
+    len  = len1 + lengthU a2
+    --
+    extract i _ = (i + 1, Just $ if i < len1 then a1!:i else a2!:(i - len1))
+
+-- |Extract all elements from an array that meet the given predicate
+--
+filterU :: MUA e => (e -> Bool) -> UArr e -> UArr e 
+{-# INLINE filterU #-}
+filterU p  = loopArr . loopU (filterEFL p) noAL
+
+-- |Concatenate the subarrays of an array of arrays
+--
+concatU :: UA e => UArr (UArr e) -> UArr e
+concatU = snd . flattenU
+
+-- |Test whether the given array is empty
+--
+nullU :: UA e => UArr e -> Bool
+nullU  = (== 0) . lengthU
+
+-- lengthU is re-exported from UArr
+
+-- |Array indexing
+--
+(!:) :: UA e => UArr e -> Int -> e
+(!:) = indexU
+
+-- |Array reduction proceeding from the left
+--
+foldlU :: UA a => (b -> a -> b) -> b -> UArr a -> b
+{-# INLINE foldlU #-}
+foldlU f z = loopAcc . loopU (foldEFL f) z
+
+-- |Array reduction that requires an associative combination function with its
+-- unit
+--
+foldU :: UA a => (a -> a -> a) -> a -> UArr a -> a
+foldU = foldlU
+
+-- |Segmented array reduction proceeding from the left
+--
+foldlSU :: (UA a, MUA b) => (b -> a -> b) -> b -> UArr (UArr a) -> UArr b
+{-# INLINE foldlSU #-}
+foldlSU f z = loopAccS . loopSU (foldEFL f) (keepSFL (const z)) z
+
+-- |Segmented array reduction that requires an associative combination
+-- function with its unit
+--
+foldSU :: MUA a => (a -> a -> a) -> a -> UArr (UArr a) -> UArr a
+foldSU = foldlSU
+
+-- |Prefix scan proceedings from left to right
+--
+scanlU :: (UA a, MUA b) => (b -> a -> b) -> b -> UArr a -> UArr b
+{-# INLINE scanlU #-}
+scanlU f z = loopArr . loopU (scanEFL f) z
+
+-- |Prefix scan proceedings from left to right that needs an associative
+-- combination function with its unit
+--
+scanU :: MUA a => (a -> a -> a) -> a -> UArr a -> UArr a
+scanU = scanlU
+
+-- |Extract a prefix of an array
+--
+takeU :: UA e=> Int -> UArr e -> UArr e
+{-# INLINE takeU #-}
+takeU n a = sliceU a 0 n
+
+-- |Extract a suffix of an array
+--
+dropU :: UA e => Int -> UArr e -> UArr e
+{-# INLINE dropU #-}
+dropU n a = let len = lengthU a 
+           in
+           sliceU a n (len - n)
+
+-- |Split an array into two halves at the given index
+--
+splitAtU :: UA e => Int -> UArr e -> (UArr e, UArr e)
+{-# INLINE splitAtU #-}
+splitAtU n a = (takeU n a, dropU n a)
+
+-- |Reverse the order of elements in an array
+--
+reverseU :: MUA e => UArr e -> UArr e
+reverseU a = loopArr $ loopU extract (len - 1) (replicateU len noAL)
+            where
+              len = lengthU a
+              --
+              extract i _ = (i - 1, Just $ a!:i)
+
+-- |
+andU :: UArr Bool -> Bool
+andU = foldU (&&) True
+
+-- |
+andSU :: UArr (UArr Bool) -> UArr Bool
+andSU = foldSU (&&) True
+
+-- |
+orU :: UArr Bool -> Bool
+orU = foldU (||) False
+
+-- |
+orSU :: UArr (UArr Bool) -> UArr Bool
+orSU = foldSU (||) False
+
+-- |
+allU :: UA e => (e -> Bool) -> UArr e -> Bool
+{-# INLINE allU #-}
+allU p = andU . mapU p
+
+-- |
+anyU :: UA e => (e -> Bool) -> UArr e -> Bool
+{-# INLINE anyU #-}
+anyU p =  orU . mapU p
+
+-- |Determine whether the given element is in an array
+--
+elemU :: (Eq e, UA e) => e -> UArr e -> Bool
+elemU e = anyU (== e)
+
+-- |Negation of `elemU'
+--
+notElemU :: (Eq e, UA e) => e -> UArr e -> Bool
+notElemU e = allU (/= e)
+
+-- |Compute the sum of an array of numerals
+--
+sumU :: (Num e, UA e) => UArr e -> e
+{-# INLINE sumU #-}
+sumU = foldU (+) 0
+
+-- |Compute the segmented sum of an array of numerals
+--
+sumSU :: (Num e, MUA e) => UArr (UArr e) -> UArr e
+{-# INLINE sumSU #-}
+sumSU = foldSU (+) 0
+
+-- |Compute the product of an array of numerals
+--
+productU :: (Num e, UA e) => UArr e -> e
+{-# INLINE productU #-}
+productU = foldU (*) 0
+
+-- |Compute the segmented product of an array of numerals
+--
+productSU :: (Num e, MUA e) => UArr (UArr e) -> UArr e
+{-# INLINE productSU #-}
+productSU = foldSU (*) 1
+
+-- |Determine the maximum element in an array
+--
+maximumU :: (Bounded e, Ord e, UA e) => UArr e -> e
+--FIXME: provisional until fold1U implemented
+--maximumU :: (Ord e, UA e) => UArr e -> e
+{-# INLINE maximumU #-}
+--maximumU = fold1U max
+maximumU = foldU max (minBound)
+
+-- |Determine the maximum element in each subarray
+--
+maximumSU :: (Bounded e, Ord e, MUA e) => UArr (UArr e) -> UArr e
+--FIXME: provisional until fold1SU implemented
+--maximumSU :: (Ord e, MUA e) => UArr (UArr e) -> UArr e
+{-# INLINE maximumSU #-}
+--maximumSU = fold1SU max
+maximumSU = foldSU max minBound
+
+-- |Determine the minimum element in an array
+--
+minimumU :: (Bounded e, Ord e, UA e) => UArr e -> e
+--FIXME: provisional until fold1U implemented
+--minimumU :: (Ord e, UA e) => UArr e -> e
+{-# INLINE minimumU #-}
+--minimumU = fold1U min
+minimumU = foldU min maxBound
+
+-- |Determine the minimum element in each subarray
+--
+minimumSU :: (Bounded e, Ord e, MUA e) => UArr (UArr e) -> UArr e
+--FIXME: provisional until fold1SU implemented
+--minimumSU :: (Ord e, MUA e) => UArr (UArr e) -> UArr e
+{-# INLINE minimumSU #-}
+--minimumSU = fold1SU min
+minimumSU = foldSU min maxBound
+
+-- zipU is re-exported from UArr
+
+-- |
+zip3U :: (UA e1, UA e2, UA e3) 
+      => UArr e1 -> UArr e2 -> UArr e3 -> UArr (e1 :*: e2 :*: e3)
+{-# INLINE zip3U #-}
+zip3U a1 a2 a3 = (a1 `zipU` a2) `zipU` a3
+
+-- |
+zipWithU :: (UA a, UA b, MUA c) 
+        => (a -> b -> c) -> UArr a -> UArr b -> UArr c
+{-# INLINE zipWithU #-}
+zipWithU f a1 a2 = 
+  loopArr $ loopU (mapEFL (\(x:*:y) -> f x y)) noAL (zipU a1 a2)
+
+-- |
+zipWith3U :: (UA a, UA b, UA c, MUA d) 
+          => (a -> b -> c -> d) -> UArr a -> UArr b -> UArr c -> UArr d
+{-# INLINE zipWith3U #-}
+zipWith3U f a1 a2 a3 = 
+  loopArr $ loopU (mapEFL (\(x:*:y:*:z) -> f x y z)) noAL (zip3U a1 a2 a3)
+
+-- unzipP is re-exported from UArr
+
+-- |
+unzip3U :: (UA e1, UA e2, UA e3) 
+       => UArr (e1 :*: e2 :*: e3) -> (UArr e1, UArr e2, UArr e3)
+{-# INLINE unzip3U #-}
+unzip3U a = let (a12, a3) = unzipU a
+               (a1 , a2) = unzipU a12
+           in
+           (a1, a2, a3)
+
+
+-- |Enumeration functions
+-- ----------------------
+
+-- |Yield an enumerated array
+--
+enumFromToU :: (Enum e, MUA e) => e -> e -> UArr e
+{-# INLINE enumFromToU #-}
+enumFromToU start = enumFromThenToU start (succ start)
+
+-- |Yield a segmented enumerated array
+--
+enumFromToSU :: (Enum e, MUA e) => UArr e -> UArr e -> UArr (UArr e)
+{-# INLINE enumFromToSU #-}
+enumFromToSU starts = enumFromThenToSU starts (mapU succ starts)
+
+-- |Yield an enumerated array using a specific step
+--
+enumFromThenToU :: (Enum e, MUA e) => e -> e -> e -> UArr e
+{-# INLINE enumFromThenToU #-}
+enumFromThenToU start next end = 
+  loopArr $ loopU step start' (replicateU len noAL)
+  where
+    start' = fromEnum start
+    next'  = fromEnum next
+    end'   = fromEnum end
+    delta  = next' - start'
+    len    = abs (end' - start' + delta) `div` (abs delta)
+    --
+    step x _ = (x + delta, Just $ toEnum x)
+
+-- |Yield a segmented enumerated array using a specific step
+--
+enumFromThenToSU :: (Enum e, MUA e) 
+                => UArr e -> UArr e -> UArr e -> UArr (UArr e)
+{-# INLINE enumFromThenToSU #-}
+enumFromThenToSU starts nexts ends = 
+  loopArrS $ loopSU step seg init (segd >: replicateU len Unit)
+  where
+    lens    = zipWith3U calcLen starts nexts ends
+             where
+               calcLen start next end = 
+                 abs (end' - start' + delta) `div` (abs delta)
+                 where
+                   start' = fromEnum start
+                   next'  = fromEnum next
+                   end'   = fromEnum end
+                   delta  = next' - start'
+    len     = sumU    lens
+    segd    = toUSegd lens
+    segdlen = lengthU lens
+    --
+    step (x, delta) _ = ((x + delta, delta), Just $ toEnum x)
+    seg  _          i = ((start, delta), Nothing::Maybe Unit)
+                       where
+                         start = fromEnum (starts!:(i + 1))
+                         next  = fromEnum (nexts !:(i + 1))
+                         delta = if (i + 1) == segdlen 
+                                 then 0 
+                                 else next - start
+    --
+    init = fst $ seg undefined (-1)