dph-seq (empty) → 0.5.1.1
raw patch · 29 files changed
+5458/−0 lines, 29 filesdep +arraydep +basedep +dph-basesetup-changed
Dependencies added: array, base, dph-base, dph-prim-seq, ghc, random, template-haskell
Files
- Data/Array/Parallel.hs +867/−0
- Data/Array/Parallel/Lifted.hs +25/−0
- Data/Array/Parallel/Lifted/Closure.hs +226/−0
- Data/Array/Parallel/Lifted/Combinators.hs +484/−0
- Data/Array/Parallel/Lifted/PArray.hs +33/−0
- Data/Array/Parallel/Lifted/Scalar.hs +239/−0
- Data/Array/Parallel/Lifted/TH/Repr.hs +488/−0
- Data/Array/Parallel/Lifted/Unboxed.hs +449/−0
- Data/Array/Parallel/PArr.hs +63/−0
- Data/Array/Parallel/PArray.hs +245/−0
- Data/Array/Parallel/PArray/Base.hs +148/−0
- Data/Array/Parallel/PArray/PData.hs +189/−0
- Data/Array/Parallel/PArray/PDataInstances.hs +481/−0
- Data/Array/Parallel/PArray/PRepr.hs +150/−0
- Data/Array/Parallel/PArray/PReprInstances.hs +205/−0
- Data/Array/Parallel/PArray/Scalar.hs +148/−0
- Data/Array/Parallel/PArray/ScalarInstances.hs +25/−0
- Data/Array/Parallel/PArray/Types.hs +84/−0
- Data/Array/Parallel/Prelude.hs +22/−0
- Data/Array/Parallel/Prelude/Bool.hs +79/−0
- Data/Array/Parallel/Prelude/Double.hs +191/−0
- Data/Array/Parallel/Prelude/Float.hs +191/−0
- Data/Array/Parallel/Prelude/Int.hs +135/−0
- Data/Array/Parallel/Prelude/Tuple.hs +15/−0
- Data/Array/Parallel/Prelude/Word8.hs +137/−0
- Data/Array/Parallel/VectDepend.hs +31/−0
- LICENSE +37/−0
- Setup.hs +3/−0
- dph-seq.cabal +68/−0
+ Data/Array/Parallel.hs view
@@ -0,0 +1,867 @@+{-# LANGUAGE ParallelArrays #-}+{-# OPTIONS_GHC -fvectorise #-}++-- | User level interface of parallel arrays.+--+-- The semantic difference between standard Haskell arrays (aka "lazy+-- arrays") and parallel arrays (aka "strict arrays") is that the evaluation+-- of two different elements of a lazy array is independent, whereas in a+-- strict array either non or all elements are evaluated. In other words,+-- when a parallel array is evaluated to WHNF, all its elements will be+-- evaluated to WHNF. The name parallel array indicates that all array+-- elements may, in general, be evaluated to WHNF in parallel without any+-- need to resort to speculative evaluation. This parallel evaluation+-- semantics is also beneficial in the sequential case, as it facilitates+-- loop-based array processing as known from classic array-based languages,+-- such as Fortran.+--+-- The interface of this module is essentially a variant of the list+-- component of the Prelude, but also includes some functions (such as+-- permutations) that are not provided for lists. The following list of+-- operations are not supported on parallel arrays, as they would require the+-- infinite parallel arrays: `iterate', `repeat', and `cycle'.+-- +-- /WARNING:/ In the current implementation, the functionality provided in+-- this module is tied to the vectoriser pass of GHC invoked by passing the+-- `-fvectorise` option. Without vectorisation these functions will not work+-- at all!++module Data.Array.Parallel (+ module Data.Array.Parallel.Prelude,+ + -- [::], -- Built-in syntax++ -- * Operations on parallel arrays '[::]'+ emptyP, singletonP, replicateP, lengthP, (!:),+ (+:+), concatP,+ mapP, filterP, combineP,+ {- minimumP, maximumP, sumP, productP, -} -- removed until we support type classes+ zipP, unzipP, zipWithP,+ {- enumFromToP, enumFromThenToP, -} -- removed until we support type classes+ bpermuteP, updateP, indexedP, sliceP,+ crossMapP,+ + -- * Conversions+ fromPArrayP, toPArrayP, fromNestedPArrayP+) where++import Data.Array.Parallel.VectDepend () -- see Note [Vectoriser dependencies] in the same module++import Data.Array.Parallel.PArr+import Data.Array.Parallel.Prelude+import Data.Array.Parallel.Lifted+import Data.Array.Parallel.Lifted.Combinators++import Prelude hiding (undefined)++infixl 9 !:+infixr 5 +:+++undefined :: a+{-# NOINLINE undefined #-}+undefined = error "Data.Array.Parallel: undefined"+{-# VECTORISE undefined + = error "Data.Array.Parallel: undefined vectorised" + :: forall a. PA a => a #-}++-- We only define the signatures of operations on parallel arrays (and bodies that convince GHC+-- that these functions don't just return diverge). The vectoriser rewrites them to entirely+-- the code given in the VECTORISE pragmas.++emptyP :: [:a:]+{-# NOINLINE emptyP #-}+emptyP = emptyPArr+{-# VECTORISE emptyP = emptyPA #-}++singletonP :: a -> [:a:]+{-# NOINLINE singletonP #-}+singletonP = singletonPArr+{-# VECTORISE singletonP = singletonPA #-}++replicateP :: Int -> a -> [:a:]+{-# NOINLINE replicateP #-}+replicateP = replicatePArr+{-# VECTORISE replicateP = replicatePA #-}++lengthP :: [:a:] -> Int+{-# NOINLINE lengthP #-}+lengthP = lengthPArr+{-# VECTORISE lengthP = lengthPA #-}++(!:) :: [:a:] -> Int -> a+{-# NOINLINE (!:) #-}+(!:) = indexPArr+{-# VECTORISE (!:) = indexPA #-}++(+:+) :: [:a:] -> [:a:] -> [:a:]+{-# NOINLINE (+:+) #-}+(+:+) xs !_ = xs+{-# VECTORISE (+:+) = appPA #-}++concatP :: [:[:a:]:] -> [:a:]+{-# NOINLINE concatP #-}+concatP xss = xss !: 0+{-# VECTORISE concatP = concatPA #-}++mapP :: (a -> b) -> [:a:] -> [:b:]+{-# NOINLINE mapP #-}+mapP !_ !_ = [::]+{-# VECTORISE mapP = mapPA #-}++filterP :: (a -> Bool) -> [:a:] -> [:a:]+{-# NOINLINE filterP #-}+filterP !_ xs = xs+{-# VECTORISE filterP = filterPA #-}++-- sumP :: Num a => [:a:] -> a+-- {-# NOINLINE sumP #-}+-- sumP a = a !: 0+-- -- no VECTORISE pragma as we still have the type-specific mock Prelude modules+-- +-- productP :: Num a => [:a:] -> a+-- {-# NOINLINE productP #-}+-- productP a = a !: 0+-- +-- maximumP :: Ord a => [:a:] -> a+-- {-# NOINLINE maximumP #-}+-- maximumP a = a !: 0+-- +-- minimumP :: Ord a => [:a:] -> a+-- {-# NOINLINE minimumP #-}+-- minimumP a = a !: 0++zipP :: [:a:] -> [:b:] -> [:(a, b):]+{-# NOINLINE zipP #-}+zipP !_ !_ = [::]+{-# VECTORISE zipP = zipPA #-}++unzipP :: [:(a, b):] -> ([:a:], [:b:])+{-# NOINLINE unzipP #-}+unzipP !_ = ([::], [::])+{-# VECTORISE unzipP = unzipPA #-}++zipWithP :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:]+{-# NOINLINE zipWithP #-}+zipWithP !_ !_ !_ = [::]+{-# VECTORISE zipWithP = zipWithPA #-}++-- enumFromToP :: Enum a => a -> a -> [:a:]+-- {-# NOINLINE enumFromToP #-}+-- enumFromToP x y = [:x, y:]+-- +-- enumFromThenToP :: Enum a => a -> a -> a -> [:a:]+-- {-# NOINLINE enumFromThenToP #-}+-- enumFromThenToP x y z = [:x, y, z:]++combineP :: [:a:] -> [:a:] -> [:Int:] -> [:a:]+{-# NOINLINE combineP #-}+combineP xs !_ !_ = xs+{-# VECTORISE combineP = combine2PA #-}++updateP :: [:a:] -> [:(Int, a):] -> [:a:]+{-# NOINLINE updateP #-}+updateP xs !_ = xs+{-# VECTORISE updateP = updatePA #-}++bpermuteP :: [:a:] -> [:Int:] -> [:a:]+{-# NOINLINE bpermuteP #-}+bpermuteP xs !_ = xs+{-# VECTORISE bpermuteP = bpermutePA #-}++indexedP :: [:a:] -> [:(Int, a):]+{-# NOINLINE indexedP #-}+indexedP !_ = [::]+{-# VECTORISE indexedP = indexedPA #-}++sliceP :: Int -> Int -> [:e:] -> [:e:]+{-# NOINLINE sliceP #-}+sliceP !_ !_ xs = xs+{-# VECTORISE sliceP = slicePA #-}++crossMapP :: [:a:] -> (a -> [:b:]) -> [:(a, b):]+{-# NOINLINE crossMapP #-}+crossMapP !_ !_ = [::]+{-# VECTORISE crossMapP = crossMapPA #-}++fromPArrayP :: PArray a -> [:a:]+{-# NOINLINE fromPArrayP #-}+fromPArrayP !_ = emptyP+{-# VECTORISE fromPArrayP = fromPArrayPA #-}++toPArrayP :: [:a:] -> PArray a+{-# NOINLINE toPArrayP #-}+toPArrayP !_ = PArray 0# undefined+{-# VECTORISE toPArrayP = toPArrayPA #-}++fromNestedPArrayP :: PArray (PArray a) -> [:[:a:]:]+{-# NOINLINE fromNestedPArrayP #-}+fromNestedPArrayP !_ = emptyP+{-# VECTORISE fromNestedPArrayP = fromNestedPArrayPA #-}++{- ================================================================================================+ This is the old code from GHC.PArr that we used to implement parallel arrays without+ vectorisation. As soon as partial vectorisation has been implemented, we should revise+ this code to support the mixed use of vectorised and non-vectorised code with parallel+ arrays. This will probably require the use of a different representation of parallel arrays+ that is a sum of the flattened and an unflattened representation.++{-# LANGUAGE MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module GHC.PArr (+ -- [::], -- Built-in syntax++ mapP, -- :: (a -> b) -> [:a:] -> [:b:]+ (+:+), -- :: [:a:] -> [:a:] -> [:a:]+ filterP, -- :: (a -> Bool) -> [:a:] -> [:a:]+ concatP, -- :: [:[:a:]:] -> [:a:]+ concatMapP, -- :: (a -> [:b:]) -> [:a:] -> [:b:]+-- head, last, tail, init, -- it's not wise to use them on arrays+ nullP, -- :: [:a:] -> Bool+ lengthP, -- :: [:a:] -> Int+ (!:), -- :: [:a:] -> Int -> a+ foldlP, -- :: (a -> b -> a) -> a -> [:b:] -> a+ foldl1P, -- :: (a -> a -> a) -> [:a:] -> a+ scanlP, -- :: (a -> b -> a) -> a -> [:b:] -> [:a:]+ scanl1P, -- :: (a -> a -> a) -> [:a:] -> [:a:]+ foldrP, -- :: (a -> b -> b) -> b -> [:a:] -> b+ foldr1P, -- :: (a -> a -> a) -> [:a:] -> a+ scanrP, -- :: (a -> b -> b) -> b -> [:a:] -> [:b:]+ scanr1P, -- :: (a -> a -> a) -> [:a:] -> [:a:]+-- iterate, repeat, -- parallel arrays must be finite+ singletonP, -- :: a -> [:a:]+ emptyP, -- :: [:a:]+ replicateP, -- :: Int -> a -> [:a:]+-- cycle, -- parallel arrays must be finite+ takeP, -- :: Int -> [:a:] -> [:a:]+ dropP, -- :: Int -> [:a:] -> [:a:]+ splitAtP, -- :: Int -> [:a:] -> ([:a:],[:a:])+ takeWhileP, -- :: (a -> Bool) -> [:a:] -> [:a:]+ dropWhileP, -- :: (a -> Bool) -> [:a:] -> [:a:]+ spanP, -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])+ breakP, -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])+-- lines, words, unlines, unwords, -- is string processing really needed+ reverseP, -- :: [:a:] -> [:a:]+ andP, -- :: [:Bool:] -> Bool+ orP, -- :: [:Bool:] -> Bool+ anyP, -- :: (a -> Bool) -> [:a:] -> Bool+ allP, -- :: (a -> Bool) -> [:a:] -> Bool+ elemP, -- :: (Eq a) => a -> [:a:] -> Bool+ notElemP, -- :: (Eq a) => a -> [:a:] -> Bool+ lookupP, -- :: (Eq a) => a -> [:(a, b):] -> Maybe b+ sumP, -- :: (Num a) => [:a:] -> a+ productP, -- :: (Num a) => [:a:] -> a+ maximumP, -- :: (Ord a) => [:a:] -> a+ minimumP, -- :: (Ord a) => [:a:] -> a+ zipP, -- :: [:a:] -> [:b:] -> [:(a, b) :]+ zip3P, -- :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]+ zipWithP, -- :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:]+ zipWith3P, -- :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]+ unzipP, -- :: [:(a, b) :] -> ([:a:], [:b:])+ unzip3P, -- :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])++ -- overloaded functions+ --+ enumFromToP, -- :: Enum a => a -> a -> [:a:]+ enumFromThenToP, -- :: Enum a => a -> a -> a -> [:a:]++ -- the following functions are not available on lists+ --+ toP, -- :: [a] -> [:a:]+ fromP, -- :: [:a:] -> [a]+ sliceP, -- :: Int -> Int -> [:e:] -> [:e:]+ foldP, -- :: (e -> e -> e) -> e -> [:e:] -> e+ fold1P, -- :: (e -> e -> e) -> [:e:] -> e+ permuteP, -- :: [:Int:] -> [:e:] -> [:e:]+ bpermuteP, -- :: [:Int:] -> [:e:] -> [:e:]+ dpermuteP, -- :: [:Int:] -> [:e:] -> [:e:] -> [:e:]+ crossP, -- :: [:a:] -> [:b:] -> [:(a, b):]+ crossMapP, -- :: [:a:] -> (a -> [:b:]) -> [:(a, b):]+ indexOfP -- :: (a -> Bool) -> [:a:] -> [:Int:]+) where++#ifndef __HADDOCK__++import Prelude++import GHC.ST ( ST(..), runST )+import GHC.Base ( Int#, Array#, Int(I#), MutableArray#, newArray#,+ unsafeFreezeArray#, indexArray#, writeArray#, (<#), (>=#) )++infixl 9 !:+infixr 5 +:++infix 4 `elemP`, `notElemP`+++-- representation of parallel arrays+-- ---------------------------------++-- this rather straight forward implementation maps parallel arrays to the+-- internal representation used for standard Haskell arrays in GHC's Prelude+-- (EXPORTED ABSTRACTLY)+--+-- * This definition *must* be kept in sync with `TysWiredIn.parrTyCon'!+--+data [::] e = PArr Int# (Array# e)+++-- exported operations on parallel arrays+-- --------------------------------------++-- operations corresponding to list operations+--++mapP :: (a -> b) -> [:a:] -> [:b:]+mapP f = fst . loop (mapEFL f) noAL++(+:+) :: [:a:] -> [:a:] -> [:a:]+a1 +:+ a2 = fst $ loop (mapEFL sel) noAL (enumFromToP 0 (len1 + len2 - 1))+ -- we can't use the [:x..y:] form here for tedious+ -- reasons to do with the typechecker and the fact that+ -- `enumFromToP' is defined in the same module+ where+ len1 = lengthP a1+ len2 = lengthP a2+ --+ sel i | i < len1 = a1!:i+ | otherwise = a2!:(i - len1)++filterP :: (a -> Bool) -> [:a:] -> [:a:]+filterP p = fst . loop (filterEFL p) noAL++concatP :: [:[:a:]:] -> [:a:]+concatP xss = foldlP (+:+) [::] xss++concatMapP :: (a -> [:b:]) -> [:a:] -> [:b:]+concatMapP f = concatP . mapP f++-- head, last, tail, init, -- it's not wise to use them on arrays++nullP :: [:a:] -> Bool+nullP [::] = True+nullP _ = False++lengthP :: [:a:] -> Int+lengthP (PArr n# _) = I# n#++(!:) :: [:a:] -> Int -> a+(!:) = indexPArr++foldlP :: (a -> b -> a) -> a -> [:b:] -> a+foldlP f z = snd . loop (foldEFL (flip f)) z++foldl1P :: (a -> a -> a) -> [:a:] -> a+foldl1P _ [::] = error "Prelude.foldl1P: empty array"+foldl1P f a = snd $ loopFromTo 1 (lengthP a - 1) (foldEFL f) (a!:0) a++scanlP :: (a -> b -> a) -> a -> [:b:] -> [:a:]+scanlP f z = fst . loop (scanEFL (flip f)) z++scanl1P :: (a -> a -> a) -> [:a:] -> [:a:]+scanl1P _ [::] = error "Prelude.scanl1P: empty array"+scanl1P f a = fst $ loopFromTo 1 (lengthP a - 1) (scanEFL f) (a!:0) a++foldrP :: (a -> b -> b) -> b -> [:a:] -> b+foldrP = error "Prelude.foldrP: not implemented yet" -- FIXME++foldr1P :: (a -> a -> a) -> [:a:] -> a+foldr1P = error "Prelude.foldr1P: not implemented yet" -- FIXME++scanrP :: (a -> b -> b) -> b -> [:a:] -> [:b:]+scanrP = error "Prelude.scanrP: not implemented yet" -- FIXME++scanr1P :: (a -> a -> a) -> [:a:] -> [:a:]+scanr1P = error "Prelude.scanr1P: not implemented yet" -- FIXME++-- iterate, repeat -- parallel arrays must be finite++singletonP :: a -> [:a:]+{-# INLINE singletonP #-}+singletonP e = replicateP 1 e+ +emptyP:: [:a:]+{- NOINLINE emptyP #-}+emptyP = replicateP 0 undefined+++replicateP :: Int -> a -> [:a:]+{-# INLINE replicateP #-}+replicateP n e = runST (do+ marr# <- newArray n e+ mkPArr n marr#)++-- cycle -- parallel arrays must be finite++takeP :: Int -> [:a:] -> [:a:]+takeP n = sliceP 0 (n - 1)++dropP :: Int -> [:a:] -> [:a:]+dropP n a = sliceP n (lengthP a - 1) a++splitAtP :: Int -> [:a:] -> ([:a:],[:a:])+splitAtP n xs = (takeP n xs, dropP n xs)++takeWhileP :: (a -> Bool) -> [:a:] -> [:a:]+takeWhileP = error "Prelude.takeWhileP: not implemented yet" -- FIXME++dropWhileP :: (a -> Bool) -> [:a:] -> [:a:]+dropWhileP = error "Prelude.dropWhileP: not implemented yet" -- FIXME++spanP :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])+spanP = error "Prelude.spanP: not implemented yet" -- FIXME++breakP :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])+breakP p = spanP (not . p)++-- lines, words, unlines, unwords, -- is string processing really needed++reverseP :: [:a:] -> [:a:]+reverseP a = permuteP (enumFromThenToP (len - 1) (len - 2) 0) a+ -- we can't use the [:x, y..z:] form here for tedious+ -- reasons to do with the typechecker and the fact that+ -- `enumFromThenToP' is defined in the same module+ where+ len = lengthP a++andP :: [:Bool:] -> Bool+andP = foldP (&&) True++orP :: [:Bool:] -> Bool+orP = foldP (||) True++anyP :: (a -> Bool) -> [:a:] -> Bool+anyP p = orP . mapP p++allP :: (a -> Bool) -> [:a:] -> Bool+allP p = andP . mapP p++elemP :: (Eq a) => a -> [:a:] -> Bool+elemP x = anyP (== x)++notElemP :: (Eq a) => a -> [:a:] -> Bool+notElemP x = allP (/= x)++lookupP :: (Eq a) => a -> [:(a, b):] -> Maybe b+lookupP = error "Prelude.lookupP: not implemented yet" -- FIXME++sumP :: (Num a) => [:a:] -> a+sumP = foldP (+) 0++productP :: (Num a) => [:a:] -> a+productP = foldP (*) 1++maximumP :: (Ord a) => [:a:] -> a+maximumP [::] = error "Prelude.maximumP: empty parallel array"+maximumP xs = fold1P max xs++minimumP :: (Ord a) => [:a:] -> a+minimumP [::] = error "Prelude.minimumP: empty parallel array"+minimumP xs = fold1P min xs++zipP :: [:a:] -> [:b:] -> [:(a, b):]+zipP = zipWithP (,)++zip3P :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]+zip3P = zipWith3P (,,)++zipWithP :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:]+zipWithP f a1 a2 = let + len1 = lengthP a1+ len2 = lengthP a2+ len = len1 `min` len2+ in+ fst $ loopFromTo 0 (len - 1) combine 0 a1+ where+ combine e1 i = (Just $ f e1 (a2!:i), i + 1)++zipWith3P :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]+zipWith3P f a1 a2 a3 = let + len1 = lengthP a1+ len2 = lengthP a2+ len3 = lengthP a3+ len = len1 `min` len2 `min` len3+ in+ fst $ loopFromTo 0 (len - 1) combine 0 a1+ where+ combine e1 i = (Just $ f e1 (a2!:i) (a3!:i), i + 1)++unzipP :: [:(a, b):] -> ([:a:], [:b:])+unzipP a = (fst $ loop (mapEFL fst) noAL a, fst $ loop (mapEFL snd) noAL a)+-- FIXME: these two functions should be optimised using a tupled custom loop+unzip3P :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])+unzip3P x = (fst $ loop (mapEFL fst3) noAL x, + fst $ loop (mapEFL snd3) noAL x,+ fst $ loop (mapEFL trd3) noAL x)+ where+ fst3 (a, _, _) = a+ snd3 (_, b, _) = b+ trd3 (_, _, c) = c++-- instances+--++instance Eq a => Eq [:a:] where+ a1 == a2 | lengthP a1 == lengthP a2 = andP (zipWithP (==) a1 a2)+ | otherwise = False++instance Ord a => Ord [:a:] where+ compare a1 a2 = case foldlP combineOrdering EQ (zipWithP compare a1 a2) of+ EQ | lengthP a1 == lengthP a2 -> EQ+ | lengthP a1 < lengthP a2 -> LT+ | otherwise -> GT+ where+ combineOrdering EQ EQ = EQ+ combineOrdering EQ other = other+ combineOrdering other _ = other++instance Functor [::] where+ fmap = mapP++instance Monad [::] where+ m >>= k = foldrP ((+:+) . k ) [::] m+ m >> k = foldrP ((+:+) . const k) [::] m+ return x = [:x:]+ fail _ = [::]++instance Show a => Show [:a:] where+ showsPrec _ = showPArr . fromP+ where+ showPArr [] s = "[::]" ++ s+ showPArr (x:xs) s = "[:" ++ shows x (showPArr' xs s)++ showPArr' [] s = ":]" ++ s+ showPArr' (y:ys) s = ',' : shows y (showPArr' ys s)++instance Read a => Read [:a:] where+ readsPrec _ a = [(toP v, rest) | (v, rest) <- readPArr a]+ where+ readPArr = readParen False (\r -> do+ ("[:",s) <- lex r+ readPArr1 s)+ readPArr1 s = + (do { (":]", t) <- lex s; return ([], t) }) +++ (do { (x, t) <- reads s; (xs, u) <- readPArr2 t; return (x:xs, u) })++ readPArr2 s = + (do { (":]", t) <- lex s; return ([], t) }) +++ (do { (",", t) <- lex s; (x, u) <- reads t; (xs, v) <- readPArr2 u; + return (x:xs, v) })++-- overloaded functions+-- ++-- Ideally, we would like `enumFromToP' and `enumFromThenToP' to be members of+-- `Enum'. On the other hand, we really do not want to change `Enum'. Thus,+-- for the moment, we hope that the compiler is sufficiently clever to+-- properly fuse the following definitions.++enumFromToP :: Enum a => a -> a -> [:a:]+enumFromToP x0 y0 = mapP toEnum (eftInt (fromEnum x0) (fromEnum y0))+ where+ eftInt x y = scanlP (+) x $ replicateP (y - x + 1) 1++enumFromThenToP :: Enum a => a -> a -> a -> [:a:]+enumFromThenToP x0 y0 z0 = + mapP toEnum (efttInt (fromEnum x0) (fromEnum y0) (fromEnum z0))+ where+ efttInt x y z = scanlP (+) x $ + replicateP (abs (z - x) `div` abs delta + 1) delta+ where+ delta = y - x++-- the following functions are not available on lists+--++-- create an array from a list (EXPORTED)+--+toP :: [a] -> [:a:]+toP l = fst $ loop store l (replicateP (length l) ())+ where+ store _ (x:xs) = (Just x, xs)++-- convert an array to a list (EXPORTED)+--+fromP :: [:a:] -> [a]+fromP a = [a!:i | i <- [0..lengthP a - 1]]++-- cut a subarray out of an array (EXPORTED)+--+sliceP :: Int -> Int -> [:e:] -> [:e:]+sliceP from to a = + fst $ loopFromTo (0 `max` from) (to `min` (lengthP a - 1)) (mapEFL id) noAL a++-- parallel folding (EXPORTED)+--+-- * the first argument must be associative; otherwise, the result is undefined+--+foldP :: (e -> e -> e) -> e -> [:e:] -> e+foldP = foldlP++-- parallel folding without explicit neutral (EXPORTED)+--+-- * the first argument must be associative; otherwise, the result is undefined+--+fold1P :: (e -> e -> e) -> [:e:] -> e+fold1P = foldl1P++-- permute an array according to the permutation vector in the first argument+-- (EXPORTED)+--+permuteP :: [:Int:] -> [:e:] -> [:e:]+permuteP is es + | isLen /= esLen = error "GHC.PArr: arguments must be of the same length"+ | otherwise = runST (do+ marr <- newArray isLen noElem+ permute marr is es+ mkPArr isLen marr)+ where+ noElem = error "GHC.PArr.permuteP: I do not exist!"+ -- unlike standard Haskell arrays, this value represents an+ -- internal error+ isLen = lengthP is+ esLen = lengthP es++-- permute an array according to the back-permutation vector in the first+-- argument (EXPORTED)+--+-- * the permutation vector must represent a surjective function; otherwise,+-- the result is undefined+--+bpermuteP :: [:Int:] -> [:e:] -> [:e:]+bpermuteP is es = fst $ loop (mapEFL (es!:)) noAL is++-- permute an array according to the permutation vector in the first+-- argument, which need not be surjective (EXPORTED)+--+-- * any elements in the result that are not covered by the permutation+-- vector assume the value of the corresponding position of the third+-- argument +--+dpermuteP :: [:Int:] -> [:e:] -> [:e:] -> [:e:]+dpermuteP is es dft+ | isLen /= esLen = error "GHC.PArr: arguments must be of the same length"+ | otherwise = runST (do+ marr <- newArray dftLen noElem+ _ <- trans 0 (isLen - 1) marr dft copyOne noAL+ permute marr is es+ mkPArr dftLen marr)+ where+ noElem = error "GHC.PArr.permuteP: I do not exist!"+ -- unlike standard Haskell arrays, this value represents an+ -- internal error+ isLen = lengthP is+ esLen = lengthP es+ dftLen = lengthP dft++ copyOne e _ = (Just e, noAL)++-- computes the cross combination of two arrays (EXPORTED)+--+crossP :: [:a:] -> [:b:] -> [:(a, b):]+crossP a1 a2 = fst $ loop combine (0, 0) $ replicateP len ()+ where+ len1 = lengthP a1+ len2 = lengthP a2+ len = len1 * len2+ --+ combine _ (i, j) = (Just $ (a1!:i, a2!:j), next)+ where+ next | (i + 1) == len1 = (0 , j + 1)+ | otherwise = (i + 1, j)++{- An alternative implementation+ * The one above is certainly better for flattened code, but here where we+ are handling boxed arrays, the trade off is less clear. However, I+ think, the above one is still better.++crossP a1 a2 = let+ len1 = lengthP a1+ len2 = lengthP a2+ x1 = concatP $ mapP (replicateP len2) a1+ x2 = concatP $ replicateP len1 a2+ in+ zipP x1 x2+ -}++-- |Compute a cross of an array and the arrays produced by the given function+-- for the elements of the first array.+--+crossMapP :: [:a:] -> (a -> [:b:]) -> [:(a, b):]+crossMapP a f = let+ bs = mapP f a+ segd = mapP lengthP bs+ as = zipWithP replicateP segd a+ in+ zipP (concatP as) (concatP bs)++{- The following may seem more straight forward, but the above is very cheap+ with segmented arrays, as `mapP lengthP', `zipP', and `concatP' are+ constant time, and `map f' uses the lifted version of `f'.++crossMapP a f = concatP $ mapP (\x -> mapP ((,) x) (f x)) a++ -}++-- computes an index array for all elements of the second argument for which+-- the predicate yields `True' (EXPORTED)+--+indexOfP :: (a -> Bool) -> [:a:] -> [:Int:]+indexOfP p a = fst $ loop calcIdx 0 a+ where+ calcIdx e idx | p e = (Just idx, idx + 1)+ | otherwise = (Nothing , idx )+++-- auxiliary functions+-- -------------------++-- internally used mutable boxed arrays+--+data MPArr s e = MPArr Int# (MutableArray# s e)++-- allocate a new mutable array that is pre-initialised with a given value+--+newArray :: Int -> e -> ST s (MPArr s e)+{-# INLINE newArray #-}+newArray (I# n#) e = ST $ \s1# ->+ case newArray# n# e s1# of { (# s2#, marr# #) ->+ (# s2#, MPArr n# marr# #)}++-- convert a mutable array into the external parallel array representation+--+mkPArr :: Int -> MPArr s e -> ST s [:e:]+{-# INLINE mkPArr #-}+mkPArr (I# n#) (MPArr _ marr#) = ST $ \s1# ->+ case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->+ (# s2#, PArr n# arr# #) }++-- general array iterator+--+-- * corresponds to `loopA' from ``Functional Array Fusion'', Chakravarty &+-- Keller, ICFP 2001+--+loop :: (e -> acc -> (Maybe e', acc)) -- mapping & folding, once per element+ -> acc -- initial acc value+ -> [:e:] -- input array+ -> ([:e':], acc)+{-# INLINE loop #-}+loop mf acc arr = loopFromTo 0 (lengthP arr - 1) mf acc arr++-- general array iterator with bounds+--+loopFromTo :: Int -- from index+ -> Int -- to index+ -> (e -> acc -> (Maybe e', acc))+ -> acc+ -> [:e:]+ -> ([:e':], acc)+{-# INLINE loopFromTo #-}+loopFromTo from to mf start arr = runST (do+ marr <- newArray (to - from + 1) noElem+ (n', acc) <- trans from to marr arr mf start+ arr' <- mkPArr n' marr+ return (arr', acc))+ where+ noElem = error "GHC.PArr.loopFromTo: I do not exist!"+ -- unlike standard Haskell arrays, this value represents an+ -- internal error++-- actual loop body of `loop'+--+-- * for this to be really efficient, it has to be translated with the+-- constructor specialisation phase "SpecConstr" switched on; as of GHC 5.03+-- this requires an optimisation level of at least -O2+--+trans :: Int -- index of first elem to process+ -> Int -- index of last elem to process+ -> MPArr s e' -- destination array+ -> [:e:] -- source array+ -> (e -> acc -> (Maybe e', acc)) -- mutator+ -> acc -- initial accumulator+ -> ST s (Int, acc) -- final destination length/final acc+{-# INLINE trans #-}+trans from to marr arr mf start = trans' from 0 start+ where+ trans' arrOff marrOff acc + | arrOff > to = return (marrOff, acc)+ | otherwise = do+ let (oe', acc') = mf (arr `indexPArr` arrOff) acc+ marrOff' <- case oe' of+ Nothing -> return marrOff + Just e' -> do+ writeMPArr marr marrOff e'+ return $ marrOff + 1+ trans' (arrOff + 1) marrOff' acc'++-- Permute the given elements into the mutable array.+--+permute :: MPArr s e -> [:Int:] -> [:e:] -> ST s ()+permute marr is es = perm 0+ where+ perm i+ | i == n = return ()+ | otherwise = writeMPArr marr (is!:i) (es!:i) >> perm (i + 1)+ where+ n = lengthP is+++-- common patterns for using `loop'+--++-- initial value for the accumulator when the accumulator is not needed+--+noAL :: ()+noAL = ()++-- `loop' mutator maps a function over array elements+--+mapEFL :: (e -> e') -> (e -> () -> (Maybe e', ()))+{-# INLINE mapEFL #-}+mapEFL f = \e _ -> (Just $ f e, ())++-- `loop' mutator that filter elements according to a predicate+--+filterEFL :: (e -> Bool) -> (e -> () -> (Maybe e, ()))+{-# INLINE filterEFL #-}+filterEFL p = \e _ -> if p e then (Just e, ()) else (Nothing, ())++-- `loop' mutator for array folding+--+foldEFL :: (e -> acc -> acc) -> (e -> acc -> (Maybe (), acc))+{-# INLINE foldEFL #-}+foldEFL f = \e a -> (Nothing, f e a)++-- `loop' mutator for array scanning+--+scanEFL :: (e -> acc -> acc) -> (e -> acc -> (Maybe acc, acc))+{-# INLINE scanEFL #-}+scanEFL f = \e a -> (Just a, f e a)++-- elementary array operations+--++-- unlifted array indexing +--+indexPArr :: [:e:] -> Int -> e+{-# INLINE indexPArr #-}+indexPArr (PArr n# arr#) (I# i#) + | i# >=# 0# && i# <# n# =+ case indexArray# arr# i# of (# e #) -> e+ | otherwise = error $ "indexPArr: out of bounds parallel array index; " +++ "idx = " ++ show (I# i#) ++ ", arr len = "+ ++ show (I# n#)++-- encapsulate writing into a mutable array into the `ST' monad+--+writeMPArr :: MPArr s e -> Int -> e -> ST s ()+{-# INLINE writeMPArr #-}+writeMPArr (MPArr n# marr#) (I# i#) e + | i# >=# 0# && i# <# n# =+ ST $ \s# ->+ case writeArray# marr# i# e s# of s'# -> (# s'#, () #)+ | otherwise = error $ "writeMPArr: out of bounds parallel array index; " +++ "idx = " ++ show (I# i#) ++ ", arr len = "+ ++ show (I# n#)++-}
+ Data/Array/Parallel/Lifted.hs view
@@ -0,0 +1,25 @@+module Data.Array.Parallel.Lifted (+ module Data.Array.Parallel.Lifted.PArray,+ module Data.Array.Parallel.PArray.PReprInstances,++ (:->), ($:), ($:^),++ fromPArrayPA, toPArrayPA, fromNestedPArrayPA,+) where++import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.Lifted.Closure+import Data.Array.Parallel.PArray.PReprInstances++fromPArrayPA :: PA a => PArray a :-> PArray a+{-# INLINE fromPArrayPA #-}+fromPArrayPA = closure1 (\x -> x) (\xs -> xs)++toPArrayPA :: PA a => PArray a :-> PArray a+{-# INLINE toPArrayPA #-}+toPArrayPA = closure1 (\x -> x) (\xs -> xs)++fromNestedPArrayPA :: PA a => (PArray (PArray a) :-> PArray (PArray a))+{-# INLINE fromNestedPArrayPA #-}+fromNestedPArrayPA = closure1 (\xs -> xs) (\xss -> xss)+
+ Data/Array/Parallel/Lifted/Closure.hs view
@@ -0,0 +1,226 @@+{-# OPTIONS -fno-warn-missing-methods #-}+module Data.Array.Parallel.Lifted.Closure (+ (:->)(..), PArray(..),+ mkClosure, mkClosureP, ($:), ($:^),+ closure, liftedClosure, liftedApply,++ closure1, closure2, closure3+) where+import Data.Array.Parallel.PArray.PReprInstances ()+import Data.Array.Parallel.PArray.PDataInstances+import Data.Array.Parallel.Lifted.PArray++import GHC.Exts (Int#)++infixr 0 :->+infixl 0 $:, $:^++-- | The type of closures.+-- This bundles up:+-- 1) the vectorised version of the function that takes an explicit environment+-- 2) the lifted version, that works on arrays.+-- the first parameter of this function is the 'lifting context'+-- that gives the length of the array.+-- 3) the environment of the closure.+-- +-- The vectoriser closure-converts the source program so that all functions+-- types are expressed in this form.+--+data a :-> b + = forall e. PA e + => Clo !(e -> a -> b) -- vectorised function+ !(Int# -> PData e -> PData a -> PData b) -- lifted function+ e -- environment+++-- | Apply a lifted function by wrapping up the provided array data+-- into some real `PArray`s, and passing it those.+lifted :: (PArray e -> PArray a -> PArray b) -- ^ lifted function to call.+ -> Int# -- ^ lifting context+ -> PData e -- ^ environments + -> PData a -- ^ arguments+ -> PData b -- ^ returned elements+{-# INLINE lifted #-}+lifted f n# es as + = case f (PArray n# es) (PArray n# as) of+ PArray _ bs -> bs+++-- | Construct a closure.+mkClosure + :: forall a b e+ . PA e+ => (e -> a -> b) -- ^ vectorised function, with explicit environment.+ -> (PArray e -> PArray a -> PArray b) -- ^ lifted function, taking an array of environments.+ -> e -- ^ environment+ -> (a :-> b)+{-# INLINE CONLIKE mkClosure #-}+mkClosure fv fl e+ = Clo fv (lifted fl) e+++-- | Construct a closure.+-- This is like the `mkClosure` function above, except that the provided+-- lifted version of the function can take raw array data, instead of +-- data wrapped up into a `PArray`.+closure :: forall a b e+ . PA e+ => (e -> a -> b) -- ^ vectorised function, with explicit environment.+ -> (Int# -> PData e -> PData a -> PData b) -- ^ lifted function, taking an array of environments.+ -> e -- ^ environment+ -> (a :-> b)+{-# INLINE closure #-}+closure fv fl e = Clo fv fl e+++-- | Apply a closure to its argument.+--+($:) :: forall a b. (a :-> b) -> a -> b+{-# INLINE ($:) #-}+Clo f _ e $: a = f e a++{-# RULES++"mkClosure/($:)" forall fv fl e x.+ mkClosure fv fl e $: x = fv e x++ #-}+++-- | Arrays of closures (aka array closures)+-- We need to represent arrays of closures when vectorising partial applications.+--+-- For example, consider:+-- @mapP (+) xs :: [: Int -> Int :]@+--+-- Representing this an array of thunks doesn't work because we can't evaluate+-- in a data parallel manner. Instead, we want *one* function applied to many+-- array elements.+-- +-- Instead, such an array of closures is represented as the vectorised +-- and lifted versions of (+), along with an environment array xs that+-- contains the partially applied arguments.+--+-- @mapP (+) xs ==> AClo plus_v plus_l xs@+--+-- When we find out what the final argument is, we can then use the lifted+-- closure application function to compute the result:+--+-- @PArray n (AClo plus_v plus_l xs) $:^ (PArray n' ys) +-- => PArray n (plus_l n xs ys)@+--+data instance PData (a :-> b)+ = forall e. PA e + => AClo !(e -> a -> b) -- vectorised function, with explicit environment.+ !(Int# -> PData e -> PData a -> PData b) -- lifted function, taking an array of environments.+ (PData e) -- array of environments.+++-- |Lifted closure construction+--+mkClosureP :: forall a b e.+ PA e => (e -> a -> b)+ -> (PArray e -> PArray a -> PArray b)+ -> PArray e -> PArray (a :-> b)+{-# INLINE mkClosureP #-}+mkClosureP fv fl (PArray n# es) + = PArray n# (AClo fv (lifted fl) es)+++liftedClosure :: forall a b e.+ PA e => (e -> a -> b)+ -> (Int# -> PData e -> PData a -> PData b)+ -> PData e+ -> PData (a :-> b)+{-# INLINE liftedClosure #-}+liftedClosure fv fl es = AClo fv fl es+++-- |Lifted closure application+--+($:^) :: forall a b. PArray (a :-> b) -> PArray a -> PArray b+{-# INLINE ($:^) #-}+PArray n# (AClo _ f es) $:^ PArray _ as + = PArray n# (f n# es as)+++liftedApply :: forall a b. Int# -> PData (a :-> b) -> PData a -> PData b+{-# INLINE liftedApply #-}+liftedApply n# (AClo _ f es) as + = f n# es as+++-- PRepr instance for closures ------------------------------------------------+type instance PRepr (a :-> b) = a :-> b++instance (PA a, PA b) => PA (a :-> b) where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id++instance PR (a :-> b) where+ {-# INLINE emptyPR #-}+ emptyPR = AClo (\_ _ -> error "empty array closure")+ (\_ _ -> error "empty array closure")+ (emptyPD :: PData ())++ {-# INLINE replicatePR #-}+ replicatePR n# (Clo f f' e) + = AClo f f' (replicatePD n# e)++ {-# INLINE replicatelPR #-}+ replicatelPR segd (AClo f f' es)+ = AClo f f' (replicatelPD segd es)++ {-# INLINE indexPR #-}+ indexPR (AClo f f' es) i#+ = Clo f f' (indexPD es i#)++ {-# INLINE bpermutePR #-}+ bpermutePR (AClo f f' es) n# is+ = AClo f f' (bpermutePD es n# is)++ {-# INLINE packByTagPR #-}+ packByTagPR (AClo f f' es) n# tags t#+ = AClo f f' (packByTagPD es n# tags t#)+++-- Closure construction -------------------------------------------------------+-- | Arity-1 closures.+closure1 :: (a -> b) -> (PArray a -> PArray b) -> (a :-> b)+{-# INLINE closure1 #-}+closure1 fv fl = mkClosure (\_ -> fv) (\_ -> fl) ()+++-- | Arity-2 closures.+closure2 :: PA a+ => (a -> b -> c)+ -> (PArray a -> PArray b -> PArray c)+ -> (a :-> b :-> c)++{-# INLINE closure2 #-}+closure2 fv fl = mkClosure fv_1 fl_1 ()+ where+ fv_1 _ x = mkClosure fv fl x+ fl_1 _ xs = mkClosureP fv fl xs+++-- | Arity-3 closures.+closure3 :: (PA a, PA b)+ => (a -> b -> c -> d)+ -> (PArray a -> PArray b -> PArray c -> PArray d)+ -> (a :-> b :-> c :-> d)++{-# INLINE closure3 #-}+closure3 fv fl = mkClosure fv_1 fl_1 ()+ where+ fv_1 _ x = mkClosure fv_2 fl_2 x+ fl_1 _ xs = mkClosureP fv_2 fl_2 xs++ fv_2 x y = mkClosure fv_3 fl_3 (x,y)+ fl_2 xs ys = mkClosureP fv_3 fl_3 (zipPA# xs ys)++ fv_3 (x,y) z = fv x y z+ fl_3 ps zs = case unzipPA# ps of (xs,ys) -> fl xs ys zs+
+ Data/Array/Parallel/Lifted/Combinators.hs view
@@ -0,0 +1,484 @@+{-# LANGUAGE CPP, BangPatterns #-}++#include "fusion-phases.h"++-- | Define the closures for the array combinators the vectoriser uses.+-- The closures themselves use the *PD primitives defined in+-- dph-common:Data.Array.Parallel.Lifted.Combinators+--+-- For each combinator:+-- The *PA_v version is the "vectorised" version that has had its +-- parameters closure converted. See zipWithPA_v for an example.+--+-- The *PA_l version is the "lifted" version that also works+-- on arrays of arrays.+--+-- The *PA version contains both of these wrapped up into a closure.+-- The output of the vectoriser uses these *PA versions directly, +-- with applications being performed by the liftedApply function +-- from "Data.Array.Parallel.Lifted.Closure"+-- +-- TODO: combine2PA_l isn't implemented and will just `error` if you+-- try to use it. None of our benchmarks do yet...+--+module Data.Array.Parallel.Lifted.Combinators (+ lengthPA, replicatePA, singletonPA, mapPA, crossMapPA,+ zipWithPA, zipPA, unzipPA, + packPA, filterPA, combine2PA, indexPA, concatPA, appPA, enumFromToPA_Int,+ indexedPA, slicePA, updatePA, bpermutePA,++ -- * Functions re-exported by Data.Array.Parallel.PArray+ lengthPA_v, replicatePA_v, singletonPA_v, zipPA_v, unzipPA_v,+ packPA_v, concatPA_v, indexedPA_v, updatePA_v, bpermutePA_v,+ slicePA_v, indexPA_v, appPA_v, enumFromToPA_v+) where+import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.Lifted.Closure+import Data.Array.Parallel.Lifted.Unboxed+import Data.Array.Parallel.Lifted.Scalar+import Data.Array.Parallel.PArray.PReprInstances+import Data.Array.Parallel.PArray.PDataInstances+import Data.Array.Parallel.PArray.ScalarInstances++import qualified Data.Array.Parallel.Unlifted as U+import Data.Array.Parallel.Base (Tag)++import GHC.Exts (Int(..), (+#))+++-- length ---------------------------------------------------------------------+-- | Take the number of elements in an array.+lengthPA :: PA a => PArray a :-> Int+{-# INLINE lengthPA #-}+lengthPA = closure1 lengthPA_v lengthPA_l++lengthPA_v :: PA a => PArray a -> Int+{-# INLINE_PA lengthPA_v #-}+lengthPA_v xs = I# (lengthPA# xs)++lengthPA_l :: PA a => PArray (PArray a) -> PArray Int+{-# INLINE_PA lengthPA_l #-}+lengthPA_l xss = fromUArrPA (U.elementsSegd segd) (U.lengthsSegd segd)+ where+ segd = segdPA# xss+++-- replicate ------------------------------------------------------------------+-- | Produce a new array by replicating a single element the given number of times.+replicatePA :: PA a => Int :-> a :-> PArray a+{-# INLINE replicatePA #-}+replicatePA = closure2 replicatePA_v replicatePA_l++replicatePA_v :: PA a => Int -> a -> PArray a+{-# INLINE_PA replicatePA_v #-}+replicatePA_v (I# n#) x = replicatePA# n# x++replicatePA_l :: PA a => PArray Int -> PArray a -> PArray (PArray a)+{-# INLINE_PA replicatePA_l #-}+replicatePA_l (PArray n# (PInt ns)) (PArray _ xs)+ = PArray n# (PNested segd (replicatelPD segd xs))+ where+ segd = U.lengthsToSegd ns+++-- singleton ------------------------------------------------------------------+-- | Produce an array containing a single element.+singletonPA :: PA a => a :-> PArray a+{-# INLINE singletonPA #-}+singletonPA = closure1 singletonPA_v singletonPA_l++singletonPA_v :: PA a => a -> PArray a+{-# INLINE_PA singletonPA_v #-}+singletonPA_v x = replicatePA_v 1 x++singletonPA_l :: PA a => PArray a -> PArray (PArray a)+{-# INLINE_PA singletonPA_l #-}+singletonPA_l (PArray n# xs)+ = PArray n# (PNested (U.mkSegd (U.replicate (I# n#) 1)+ (U.enumFromStepLen 0 1 (I# n#))+ (I# n#))+ xs)+++-- map ------------------------------------------------------------------------+-- | Apply a worker function to each element of an array, yielding a new array.+mapPA :: (PA a, PA b) => (a :-> b) :-> PArray a :-> PArray b+{-# INLINE mapPA #-}+mapPA = closure2 mapPA_v mapPA_l++-- | When performing a map we `replicate` the function into an array, then use+-- lifted-application to apply each function to its corresponding argument.+--+-- Note that this is a virtual replicate only, meaning that we can use+-- the same vectorised and lifted worker functions, provided we replicate+-- the environment part of the closure. The instance for repliatePA# in+-- PRepr class does exactly this, and it's defined in +-- "Data.Array.Parallel.Lifted.Closure".+--+mapPA_v :: (PA a, PA b) => (a :-> b) -> PArray a -> PArray b+{-# INLINE_PA mapPA_v #-}+mapPA_v f as = replicatePA# (lengthPA# as) f $:^ as++mapPA_l :: (PA a, PA b)+ => PArray (a :-> b) -> PArray (PArray a) -> PArray (PArray b)+{-# INLINE_PA mapPA_l #-}+mapPA_l (PArray n# clo) (PArray _ xss)+ = PArray n#+ $ case xss of { PNested segd xs ->+ PNested segd+ $ liftedApply (case U.elementsSegd segd of { I# k# -> k# })+ (replicatelPD segd clo)+ xs }+ ++-- crossMap -------------------------------------------------------------------+-- TODO: What does this do?+crossMapPA :: (PA a, PA b) => (PArray a :-> (a :-> PArray b) :-> PArray (a,b))+{-# INLINE crossMapPA #-}+crossMapPA = closure2 crossMapPA_v crossMapPA_l++crossMapPA_v :: (PA a, PA b) => PArray a -> (a :-> PArray b) -> PArray (a,b)+{-# INLINE_PA crossMapPA_v #-}+crossMapPA_v as f+ = zipPA# (replicatelPA# (segdPA# bss) as) (concatPA# bss)+ where+ bss = mapPA_v f as++crossMapPA_l :: (PA a, PA b)+ => PArray (PArray a)+ -> PArray (a :-> PArray b)+ -> PArray (PArray (a,b))+{-# INLINE_PA crossMapPA_l #-}+crossMapPA_l ass fs = copySegdPA# bss (zipPA# as' (concatPA# bss))+ where+ bsss = mapPA_l fs ass+ bss = concatPA_l bsss+ as' = replicatelPA# (segdPA# (concatPA# bsss)) (concatPA# ass)+++-- zip ------------------------------------------------------------------------+-- | Takes two arrays and returns an array of corresponding pairs.+-- If one array is short, excess elements of the longer array are discarded.+zipPA :: (PA a, PA b) => PArray a :-> PArray b :-> PArray (a,b)+{-# INLINE zipPA #-}+zipPA = closure2 zipPA_v zipPA_l++zipPA_v :: (PA a, PA b) => PArray a -> PArray b -> PArray (a,b)+{-# INLINE_PA zipPA_v #-}+zipPA_v xs ys = zipPA# xs ys++zipPA_l :: (PA a, PA b)+ => PArray (PArray a) -> PArray (PArray b) -> PArray (PArray (a,b))+{-# INLINE_PA zipPA_l #-}+zipPA_l (PArray n# (PNested segd xs)) (PArray _ (PNested _ ys))+ = PArray n# (PNested segd (P_2 xs ys))+++-- zipWith --------------------------------------------------------------------+-- | zipWith generalises zip by zipping with the function given as the first+-- argument, instead of a tupling function.+zipWithPA :: (PA a, PA b, PA c)+ => (a :-> b :-> c) :-> PArray a :-> PArray b :-> PArray c+{-# INLINE zipWithPA #-}+zipWithPA = closure3 zipWithPA_v zipWithPA_l++zipWithPA_v :: (PA a, PA b, PA c)+ => (a :-> b :-> c) -> PArray a -> PArray b -> PArray c+{-# INLINE_PA zipWithPA_v #-}+zipWithPA_v f as bs = replicatePA# (lengthPA# as) f $:^ as $:^ bs++zipWithPA_l :: (PA a, PA b, PA c)+ => PArray (a :-> b :-> c) -> PArray (PArray a) -> PArray (PArray b)+ -> PArray (PArray c)+{-# INLINE_PA zipWithPA_l #-}+zipWithPA_l fs ass bss+ = copySegdPA# ass+ (replicatelPA# (segdPA# ass) fs $:^ concatPA# ass $:^ concatPA# bss)+++-- unzip ----------------------------------------------------------------------+-- | Transform an array into an array of the first components,+-- and an array of the second components.+unzipPA:: (PA a, PA b) => PArray (a, b) :-> (PArray a, PArray b)+{-# INLINE unzipPA #-}+unzipPA = closure1 unzipPA_v unzipPA_l++unzipPA_v:: (PA a, PA b) => PArray (a,b) -> (PArray a, PArray b)+{-# INLINE_PA unzipPA_v #-}+unzipPA_v abs' = unzipPA# abs'++unzipPA_l:: (PA a, PA b) => PArray (PArray (a, b)) -> PArray (PArray a, PArray b)+{-# INLINE_PA unzipPA_l #-}+unzipPA_l xyss = zipPA# (copySegdPA# xyss xs) (copySegdPA# xyss ys)+ where+ (xs, ys) = unzipPA# (concatPA# xyss)+++-- packPA ---------------------------------------------------------------------+-- | Select the elements of an array that have their tag set as True.+-- +-- @+-- packPA [12, 24, 42, 93] [True, False, False, True]+-- = [24, 42]+-- @+--+packPA :: PA a => PArray a :-> PArray Bool :-> PArray a+{-# INLINE packPA #-}+packPA = closure2 packPA_v packPA_l++packPA_v :: PA a => PArray a -> PArray Bool -> PArray a+{-# INLINE_PA packPA_v #-}+packPA_v xs bs+ = packByTagPA# xs (elementsSel2_1# sel) (U.tagsSel2 sel) 1#+ where+ sel = boolSel bs++packPA_l :: PA a+ => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)+{-# INLINE_PA packPA_l #-}+packPA_l (PArray n# xss) (PArray _ bss)+ = PArray n#+ $ case xss of { PNested segd xs ->+ case bss of { PNested _ (PBool sel) ->+ PNested (U.lengthsToSegd $ U.count_s segd (U.tagsSel2 sel) 1)+ $ packByTagPD xs (elementsSel2_1# sel) (U.tagsSel2 sel) 1# }}++boolSel :: PArray Bool -> U.Sel2+{-# INLINE boolSel #-}+boolSel (PArray _ (PBool sel)) = sel+++-- combine --------------------------------------------------------------------+-- | Combine two arrays, using a tag array to tell us where to get each element from.+--+-- @combine2 [1,2,3] [4,5,6] [T,F,F,T,T,F] = [1,4,5,2,3,6]@+--+-- TODO: should the selector be a boolean array?+--+combine2PA:: PA a => PArray a :-> PArray a :-> PArray Tag :-> PArray a+{-# INLINE_PA combine2PA #-}+combine2PA = closure3 combine2PA_v combine2PA_l++combine2PA_v:: PA a => PArray a -> PArray a -> PArray Tag -> PArray a+{-# INLINE_PA combine2PA_v #-}+combine2PA_v xs ys bs+ = combine2PA# (lengthPA# xs +# lengthPA# ys)+ (U.tagsToSel2 (toUArrPA bs))+ xs ys++combine2PA_l+ :: PA a+ => PArray (PArray a) -> PArray (PArray a)+ -> PArray (PArray Tag)+ -> PArray (PArray a)+{-# INLINE_PA combine2PA_l #-}+combine2PA_l _ _ _ + = error "dph-common:Data.Array.Parallel.Lifted.Combinators: combinePA_l isn't implemented"+++-- filter ---------------------------------------------------------------------+-- | Extract the elements from an array that match the given predicate.+filterPA :: PA a => (a :-> Bool) :-> PArray a :-> PArray a+{-# INLINE filterPA #-}+filterPA = closure2 filterPA_v filterPA_l++filterPA_v :: PA a => (a :-> Bool) -> PArray a -> PArray a+{-# INLINE_PA filterPA_v #-}+filterPA_v p xs = packPA_v xs (mapPA_v p xs)++filterPA_l :: PA a+ => PArray (a :-> Bool) -> PArray (PArray a) -> PArray (PArray a)+{-# INLINE_PA filterPA_l #-}+filterPA_l ps xss = packPA_l xss (mapPA_l ps xss)+++-- index ----------------------------------------------------------------------+-- | Retrieve the array element with the given index.+indexPA :: PA a => PArray a :-> Int :-> a+{-# INLINE indexPA #-}+indexPA = closure2 indexPA_v indexPA_l++indexPA_v :: PA a => PArray a -> Int -> a+{-# INLINE_PA indexPA_v #-}+indexPA_v xs (I# i#) = indexPA# xs i#++indexPA_l :: PA a => PArray (PArray a) -> PArray Int -> PArray a+{-# INLINE_PA indexPA_l #-}+indexPA_l (PArray _ (PNested segd xs)) (PArray n# is)+ = PArray n#+ $ bpermutePD xs n#+ (U.zipWith (+) (U.indicesSegd segd)+ (fromScalarPData is))+++-- concat ---------------------------------------------------------------------+-- | Concatenate an array of arrays into a single array.+concatPA :: PA a => PArray (PArray a) :-> PArray a+{-# INLINE concatPA #-}+concatPA = closure1 concatPA_v concatPA_l++concatPA_v :: PA a => PArray (PArray a) -> PArray a+{-# INLINE_PA concatPA_v #-}+concatPA_v xss = concatPA# xss++concatPA_l :: PA a => PArray (PArray (PArray a)) -> PArray (PArray a)+{-# INLINE_PA concatPA_l #-}+concatPA_l (PArray m# (PNested segd1 (PNested segd2 xs)))+ = PArray m#+ (PNested (U.mkSegd (U.sum_s segd1 (U.lengthsSegd segd2))+ (U.bpermute (U.indicesSegd segd2) (U.indicesSegd segd1))+ (U.elementsSegd segd2))+ xs)+++-- app (append) ---------------------------------------------------------------+-- | Append two arrays.+appPA :: PA a => PArray a :-> PArray a :-> PArray a+{-# INLINE appPA #-}+appPA = closure2 appPA_v appPA_l++appPA_v :: PA a => PArray a -> PArray a -> PArray a+{-# INLINE_PA appPA_v #-}+appPA_v xs ys = appPA# xs ys++appPA_l :: PA a => PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)+{-# INLINE_PA appPA_l #-}+appPA_l (PArray m# pxss) (PArray n# pyss)+ = PArray (m# +# n#)+ $ case pxss of { PNested xsegd xs ->+ case pyss of { PNested ysegd ys ->+ let+ segd = U.plusSegd xsegd ysegd+ in+ PNested segd (applPD segd xsegd xs ysegd ys) }}+++-- enumFromTo -----------------------------------------------------------------+-- | Produce a range of integers.+enumFromToPA_Int :: Int :-> Int :-> PArray Int+{-# INLINE enumFromToPA_Int #-}+enumFromToPA_Int = closure2 enumFromToPA_v enumFromToPA_l++enumFromToPA_v :: Int -> Int -> PArray Int+{-# INLINE_PA enumFromToPA_v #-}+enumFromToPA_v m n = fromUArrPA (distance m n) (U.enumFromTo m n)++distance :: Int -> Int -> Int+{-# INLINE_STREAM distance #-}+distance m n = max 0 (n - m + 1)++enumFromToPA_l :: PArray Int -> PArray Int -> PArray (PArray Int)+{-# INLINE_PA enumFromToPA_l #-}+enumFromToPA_l (PArray m# ms) (PArray _ ns)+ = PArray m#+ $ PNested segd+ $ toScalarPData+ $ U.enumFromStepLenEach (U.elementsSegd segd)+ (fromScalarPData ms) (U.replicate (U.elementsSegd segd) 1) lens+ where+ lens = U.zipWith distance (fromScalarPData ms) (fromScalarPData ns)+ segd = U.lengthsToSegd lens+++-- indexed --------------------------------------------------------------------+-- | Tag each element of an array with its index.+--+-- @indexed [42, 93, 13] = [(0, 42), (1, 93), (2, 13)]@ +--+indexedPA :: PA a => PArray a :-> PArray (Int,a)+{-# INLINE indexedPA #-}+indexedPA = closure1 indexedPA_v indexedPA_l++indexedPA_v :: PA a => PArray a -> PArray (Int,a)+{-# INLINE indexedPA_v #-}+indexedPA_v (PArray n# xs)+ = PArray n# (P_2 (toScalarPData $ U.enumFromStepLen 0 1 (I# n#)) xs)++indexedPA_l :: PA a => PArray (PArray a) -> PArray (PArray (Int,a))+{-# INLINE indexedPA_l #-}+indexedPA_l (PArray n# xss)+ = PArray n#+ $ case xss of { PNested segd xs ->+ PNested segd (P_2 (toScalarPData $ U.indices_s segd) xs) }+++-- slice ----------------------------------------------------------------------+-- | Extract a subrange of elements from an array.+-- The first argument is the starting index, while the second is the +-- length of the slice.+-- +slicePA :: PA a => Int :-> Int :-> PArray a :-> PArray a+{-# INLINE slicePA #-}+slicePA = closure3 slicePA_v slicePA_l++slicePA_v :: PA a => Int -> Int -> PArray a -> PArray a+{-# INLINE slicePA_v #-}+slicePA_v (I# from) (I# len) xs + = extractPA# xs from len ++-- TODO: Can we define this in terms of extractPA?+slicePA_l :: PA a => PArray Int -> PArray Int -> PArray (PArray a) -> PArray (PArray a)+{-# INLINE slicePA_l #-}+slicePA_l (PArray n# is) (PArray _ lens) (PArray _ xss)+ = PArray n#+ $ case xss of { PNested segd xs ->+ PNested segd'+ $ bpermutePD xs (elementsSegd# segd')+ (U.zipWith (+) (U.indices_s segd')+ (U.replicate_s segd'+ (U.zipWith (+) (fromScalarPData is)+ (U.indicesSegd segd)))) }+ where+ segd' = U.lengthsToSegd (fromScalarPData lens)++++-- update ---------------------------------------------------------------------+-- | Copy the source array in the destination, using new values for the given indices.+updatePA :: PA a => PArray a :-> PArray (Int,a) :-> PArray a+{-# INLINE updatePA #-}+updatePA = closure2 updatePA_v updatePA_l++updatePA_v :: PA a => PArray a -> PArray (Int,a) -> PArray a+{-# INLINE_PA updatePA_v #-}+updatePA_v xs (PArray n# (P_2 is ys))+ = updatePA# xs (fromScalarPData is) (PArray n# ys)++updatePA_l+ :: PA a => PArray (PArray a) -> PArray (PArray (Int,a)) -> PArray (PArray a)+{-# INLINE_PA updatePA_l #-}+updatePA_l (PArray m# xss) (PArray _ pss)+ = PArray m#+ $ case xss of { PNested segd xs ->+ case pss of { PNested segd' (P_2 is ys) ->+ PNested segd+ $ updatePD xs (U.zipWith (+) (fromScalarPData is)+ (U.replicate_s segd' (U.indicesSegd segd)))+ ys }}+++-- bpermute -------------------------------------------------------------------+-- | Backwards permutation of array elements.+--+-- @bpermute [50, 60, 20, 30] [0, 3, 2] = [50, 30, 20]@+--+bpermutePA :: PA a => PArray a :-> PArray Int :-> PArray a+{-# INLINE bpermutePA #-}+bpermutePA = closure2 bpermutePA_v bpermutePA_l++bpermutePA_v :: PA a => PArray a -> PArray Int -> PArray a+{-# INLINE_PA bpermutePA_v #-}+bpermutePA_v xs (PArray n# is) = bpermutePA# xs n# (fromScalarPData is)++bpermutePA_l :: PA a => PArray (PArray a) -> PArray (PArray Int) -> PArray (PArray a)+{-# INLINE_PA bpermutePA_l #-}+bpermutePA_l (PArray _ xss) (PArray n# iss)+ = PArray n#+ $ case xss of { PNested segd xs ->+ case iss of { PNested isegd is ->+ PNested isegd+ $ bpermutePD xs (elementsSegd# isegd)+ (U.zipWith (+) (fromScalarPData is)+ (U.replicate_s isegd (U.indicesSegd segd))) }}++
+ Data/Array/Parallel/Lifted/PArray.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP, FlexibleContexts #-}++#include "fusion-phases.h"++--+module Data.Array.Parallel.Lifted.PArray (+ PArray(..), PData,++ PA(..),+ lengthPA#, dataPA#, replicatePA#, replicatelPA#, repeatPA#,+ emptyPA, indexPA#, extractPA#, bpermutePA#, appPA#, applPA#,+ packByTagPA#, combine2PA#, updatePA#, fromListPA#, fromListPA, nfPA,++ replicatePD, replicatelPD, repeatPD, emptyPD,+ indexPD, extractPD, bpermutePD, appPD, applPD,+ packByTagPD, combine2PD, updatePD, fromListPD, nfPD,++ PRepr, PR(..),++ Scalar(..),+ replicatePRScalar, replicatelPRScalar, repeatPRScalar, emptyPRScalar,+ indexPRScalar, extractPRScalar, bpermutePRScalar, appPRScalar, applPRScalar,+ packByTagPRScalar, combine2PRScalar, updatePRScalar, fromListPRScalar,+ nfPRScalar,+) where+import Data.Array.Parallel.PArray.PRepr+import Data.Array.Parallel.PArray.Scalar+import Data.Array.Parallel.PArray.PData+import Data.Array.Parallel.PArray.Base++++
+ Data/Array/Parallel/Lifted/Scalar.hs view
@@ -0,0 +1,239 @@+{-# OPTIONS -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}++#include "fusion-phases.h"++module Data.Array.Parallel.Lifted.Scalar+where+import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.PArray.PReprInstances+import Data.Array.Parallel.PArray.PDataInstances+import qualified Data.Array.Parallel.Unlifted as U+import Data.Array.Parallel.Base (fromBool, toBool)+import GHC.Exts (Int(..))+++-- Pretend Bools are scalars --------------------------------------------------+instance Scalar Bool where+ {-# INLINE toScalarPData #-}+ toScalarPData bs+ = PBool (U.tagsToSel2 (U.map fromBool bs))++ {-# INLINE fromScalarPData #-}+ fromScalarPData (PBool sel) = U.map toBool (U.tagsSel2 sel)+++-- Projections ----------------------------------------------------------------+prim_lengthPA :: Scalar a => PArray a -> Int+{-# INLINE prim_lengthPA #-}+prim_lengthPA xs = I# (lengthPA# xs)+++-- Conversion -----------------------------------------------------------------+-- | Create a PArray out of a scalar U.Array, +-- the first argument is the array length.+--+-- TODO: ditch this version, just use fromUArrPA'+--+fromUArrPA :: Scalar a => Int -> U.Array a -> PArray a+{-# INLINE fromUArrPA #-}+fromUArrPA (I# n#) xs = PArray n# (toScalarPData xs)+++-- | Create a PArray out of a scalar U.Array,+-- reading the length directly from the U.Array.+fromUArrPA' :: Scalar a => U.Array a -> PArray a+{-# INLINE fromUArrPA' #-}+fromUArrPA' xs = fromUArrPA (U.length xs) xs+++-- | Convert a PArray back to a plain U.Array.+toUArrPA :: Scalar a => PArray a -> U.Array a+{-# INLINE toUArrPA #-}+toUArrPA (PArray _ xs) = fromScalarPData xs+++-- Tuple Conversions ----------------------------------------------------------+-- | Convert an U.Array of pairs to a PArray.+fromUArrPA_2+ :: (Scalar a, Scalar b)+ => Int -> U.Array (a,b) -> PArray (a,b)+{-# INLINE fromUArrPA_2 #-}+fromUArrPA_2 (I# n#) ps+ = PArray n# (P_2 (toScalarPData xs) (toScalarPData ys))+ where+ (xs,ys) = U.unzip ps+++-- | Convert a U.Array of pairs to a PArray,+-- reading the length directly from the U.Array.+fromUArrPA_2'+ :: (Scalar a, Scalar b)+ => U.Array (a,b) -> PArray (a, b)+{-# INLINE fromUArrPA_2' #-}+fromUArrPA_2' ps + = fromUArrPA_2 (U.length ps) ps+++-- | Convert a U.Array of triples to a PArray.+fromUArrPA_3+ :: (Scalar a, Scalar b, Scalar c)+ => Int -> U.Array ((a,b),c) -> PArray (a,b,c)+{-# INLINE fromUArrPA_3 #-}+fromUArrPA_3 (I# n#) ps+ = PArray n# (P_3 (toScalarPData xs)+ (toScalarPData ys)+ (toScalarPData zs))+ where+ (qs,zs) = U.unzip ps+ (xs,ys) = U.unzip qs+++-- | Convert a U.Array of triples to a PArray,+-- reading the length directly from the U.Array.+fromUArrPA_3' + :: (Scalar a, Scalar b, Scalar c)+ => U.Array ((a,b),c) -> PArray (a, b, c)+{-# INLINE fromUArrPA_3' #-}+fromUArrPA_3' ps = fromUArrPA_3 (U.length ps) ps+++-- Nesting arrays -------------------------------------------------------------+-- | O(1). Create a nested array.+nestUSegdPA+ :: Int -- ^ total number of elements in the nested array+ -> U.Segd -- ^ segment descriptor+ -> PArray a -- ^ array of data elements.+ -> PArray (PArray a)++{-# INLINE nestUSegdPA #-}+nestUSegdPA (I# n#) segd (PArray _ xs)+ = PArray n# (PNested segd xs)+++-- | O(1). Create a nested array,+-- using the same length as the source array.+nestUSegdPA'+ :: U.Segd -- ^ segment descriptor+ -> PArray a -- ^ array of data elements+ -> PArray (PArray a)++{-# INLINE nestUSegdPA' #-}+nestUSegdPA' segd xs + = nestUSegdPA (U.lengthSegd segd) segd xs+++-- Scalar Operators -----------------------------------------------------------+-- These work on PArrays of scalar elements.+-- TODO: Why do we need these versions as well as the standard ones?++-- | Apply a worker function to every element of an array, yielding a new array.+scalar_map + :: (Scalar a, Scalar b) + => (a -> b) -> PArray a -> PArray b++{-# INLINE_PA scalar_map #-}+scalar_map f xs + = fromUArrPA (prim_lengthPA xs)+ . U.map f+ $ toUArrPA xs+++-- | Zip two arrays, yielding a new array.+scalar_zipWith+ :: (Scalar a, Scalar b, Scalar c)+ => (a -> b -> c) -> PArray a -> PArray b -> PArray c++{-# INLINE_PA scalar_zipWith #-}+scalar_zipWith f xs ys+ = fromUArrPA (prim_lengthPA xs)+ $ U.zipWith f (toUArrPA xs) (toUArrPA ys)+++-- | Zip three arrays, yielding a new array.+scalar_zipWith3+ :: (Scalar a, Scalar b, Scalar c, Scalar d)+ => (a -> b -> c -> d) -> PArray a -> PArray b -> PArray c -> PArray d++{-# INLINE_PA scalar_zipWith3 #-}+scalar_zipWith3 f xs ys zs+ = fromUArrPA (prim_lengthPA xs)+ $ U.zipWith3 f (toUArrPA xs) (toUArrPA ys) (toUArrPA zs)+++-- | Left fold over an array.+scalar_fold + :: Scalar a+ => (a -> a -> a) -> a -> PArray a -> a++{-# INLINE_PA scalar_fold #-}+scalar_fold f z+ = U.fold f z . toUArrPA+++-- | Left fold over an array, using the first element to initialise the state.+scalar_fold1 + :: Scalar a+ => (a -> a -> a) -> PArray a -> a++{-# INLINE_PA scalar_fold1 #-}+scalar_fold1 f+ = U.fold1 f . toUArrPA+++-- | Segmented fold of an array of arrays.+-- Each segment is folded individually, yielding an array of the fold results.+scalar_folds + :: Scalar a+ => (a -> a -> a) -> a -> PArray (PArray a) -> PArray a++{-# INLINE_PA scalar_folds #-}+scalar_folds f z xss+ = fromUArrPA (prim_lengthPA (concatPA# xss))+ . U.fold_s f z (segdPA# xss)+ . toUArrPA+ $ concatPA# xss+++-- | Segmented fold of an array of arrays, using the first element of each+-- segment to initialse the state for that segment.+-- Each segment is folded individually, yielding an array of all the fold results.+scalar_fold1s+ :: Scalar a+ => (a -> a -> a) -> PArray (PArray a) -> PArray a++{-# INLINE_PA scalar_fold1s #-}+scalar_fold1s f xss+ = fromUArrPA (prim_lengthPA (concatPA# xss))+ . U.fold1_s f (segdPA# xss)+ . toUArrPA+ $ concatPA# xss+++-- | Left fold over an array, also passing the index of each element+-- to the parameter function.+scalar_fold1Index+ :: Scalar a+ => ((Int, a) -> (Int, a) -> (Int, a)) -> PArray a -> Int++{-# INLINE_PA scalar_fold1Index #-}+scalar_fold1Index f+ = fst . U.fold1 f . U.indexed . toUArrPA+++-- | Segmented fold over an array, also passing the index of each +-- element to the parameter function.+scalar_fold1sIndex+ :: Scalar a+ => ((Int, a) -> (Int, a) -> (Int, a))+ -> PArray (PArray a) -> PArray Int++{-# INLINE_PA scalar_fold1sIndex #-}+scalar_fold1sIndex f (PArray m# (PNested segd xs))+ = PArray m#+ $ toScalarPData+ $ U.fsts+ $ U.fold1_s f segd+ $ U.zip (U.indices_s segd)+ $ fromScalarPData xs+
+ Data/Array/Parallel/Lifted/TH/Repr.hs view
@@ -0,0 +1,488 @@+{-# LANGUAGE TemplateHaskell, Rank2Types #-}+module Data.Array.Parallel.Lifted.TH.Repr (+ scalarInstances, tupleInstances,+ voidPRInstance, unitPRInstance, wrapPRInstance+) where++import qualified Data.Array.Parallel.Unlifted as U+import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.Base.DTrace (traceFn)++import Language.Haskell.TH+import Data.List (intercalate)++tyBndrVar :: TyVarBndr -> Name+tyBndrVar (PlainTV n) = n+tyBndrVar (KindedTV n _) = n++mkAppTs :: Type -> [Type] -> Type+mkAppTs = foldl AppT++varTs :: [Name] -> [TypeQ]+varTs = map varT++appTs :: TypeQ -> [TypeQ] -> TypeQ+appTs = foldl appT++varEs :: [Name] -> [ExpQ]+varEs = map varE++appEs :: ExpQ -> [ExpQ] -> ExpQ+appEs = foldl appE++normalMatch :: PatQ -> ExpQ -> MatchQ+normalMatch pat xx = match pat (normalB xx) []++varPs :: [Name] -> [PatQ]+varPs = map varP++vanillaC :: Name -> [TypeQ] -> ConQ+vanillaC con tys = normalC con (map (strictType notStrict) tys)+++simpleFunD :: Name -> [PatQ] -> ExpQ -> DecQ+simpleFunD name pats xx+ = funD name [clause pats (normalB xx) []]+++inlineD :: Name -> DecQ+inlineD name = pragInlD name (inlineSpecNoPhase True False)+++instance_PData :: TypeQ -> [Name] -> Name -> [TypeQ] -> DecQ+instance_PData tycon tyargs con tys+ = dataInstD (cxt []) ''PData [tycon `appTs` varTs tyargs]+ [vanillaC con tys]+ []+++newtype_instance_PData :: Name -> [Name] -> Name -> TypeQ -> DecQ+newtype_instance_PData tycon tyargs con ty+ = newtypeInstD (cxt []) ''PData [conT tycon `appTs` varTs tyargs]+ (vanillaC con [ty])+ []+++splitConAppTy :: Type -> Maybe (Type, [Type])+splitConAppTy ty = collect ty []+ where+ collect (ConT tycon) args = Just (ConT tycon, args)+ collect (TupleT n) args = Just (TupleT n, args)+ collect ListT args = Just (ListT, args)+ collect ArrowT args = Just (ArrowT, args)+ collect (AppT t arg) args = collect t (arg:args)+ collect _ _ = Nothing+++normaliseTy :: Type -> Q Type+normaliseTy ty+ = case splitConAppTy ty of+ Just (ConT tycon, args)+ -> do+ info <- reify tycon+ case info of+ TyConI (TySynD _ bndrs t)+ -> return $ substTy (zip (map tyBndrVar bndrs) args) t+ _ -> return ty+ _ -> return ty+++substTy :: [(Name, Type)] -> Type -> Type+substTy _ (ForallT _ _ _) + = error "DPH gen: can't substitute in forall ty"++substTy env (VarT v) = case lookup v env of+ Just ty -> ty+ Nothing -> VarT v+substTy env (AppT t u) = AppT (substTy env t) (substTy env u)+substTy env (SigT t k) = SigT (substTy env t) k+substTy _ t = t+++splitFunTy :: Type -> ([Type], Type)+splitFunTy ty = case splitConAppTy ty of+ Just (ArrowT, [arg, r]) -> let (args, res) = splitFunTy r+ in (arg:args, res)+ _ -> ([], ty)++data Val = ScalarVal+ | PDataVal+ | ListVal+ | UnitVal+ | OtherVal+type NameGen = String -> String+type ArgVal = (Val, NameGen)++genPR_methods :: (Name -> [ArgVal] -> Val -> DecQ) -> Q [Dec]+genPR_methods mk_method+ = do+ ClassI (ClassD _ _ _ _ decs) _ <- reify ''PR+ inls <- sequence [inlineD $ mkName $ nameBase name | SigD name _ <- decs]+ defs <- mapM gen [(name, ty) | SigD name ty <- decs]+ return $ inls ++ defs+ where+ gen (name, ty)+ = case lookup name nameGens of+ Just gs -> do+ (args, res) <- methodVals ty+ mk_method name (zip args gs) res+ Nothing -> error $ "DPH gen: no name generator for " ++ show name+++methodVals :: Type -> Q ([Val], Val)+methodVals (ForallT (PlainTV vv : _) _ ty)+ = do+ ty' <- normaliseTy ty+ let (args, res) = splitFunTy ty'++ return (map (val vv) args, val vv res)+ where+ val v (VarT n) | v == n = ScalarVal++ val v (AppT (ConT c) (VarT n)) + | c == ''PData && v == n = PDataVal+ | c == ''[] && v == n = ListVal++ val v (AppT ListT (VarT n)) | v==n = ListVal+ val _ (ConT c) | c == ''() = UnitVal+ val _ (TupleT 0) = UnitVal+ val _ _ = OtherVal++methodVals tt+ = error $ "DPH gen: methodVals: no match for " ++ show tt+++data Split = PatSplit PatQ+ | CaseSplit PatQ ExpQ PatQ++data Arg = RecArg [ExpQ] [ExpQ]+ | OtherArg ExpQ++data Gen = Gen {+ recursiveCalls :: Int+ , recursiveName :: Name -> Name+ , split :: ArgVal -> (Split, Arg)+ , join :: Val -> [ExpQ] -> ExpQ+ , typeName :: String+ }++recursiveMethod :: Gen -> Name -> [ArgVal] -> Val -> DecQ+recursiveMethod gen name avs res+ = simpleFunD (mkName $ nameBase name) (map pat splits)+ $ appE (varE 'traceFn `appEs` [stringE (nameBase name), stringE (typeName gen)])+ $ foldr mk_case+ (join gen res+ . recurse (recursiveCalls gen)+ . trans+ $ map expand args)+ splits+ where+ (splits, args) = unzip (map split_arg avs)++ pat (PatSplit p) = p+ pat (CaseSplit p _ _) = p++ split_arg (OtherVal, g) + = let v = mkName (g "")+ in (PatSplit (varP v), OtherArg (varE v))++ split_arg arg = split gen arg++ mk_case (PatSplit _) xx = xx+ mk_case (CaseSplit _ scrut pat') xx = caseE scrut [normalMatch pat' xx]++ expand (RecArg _ es) = es+ expand (OtherArg e) = repeat e++ trans [] = []+ trans [xs] = [[x] | x <- xs]+ trans (xs : yss) = zipWith (:) xs (trans yss)++ recurse 0 _ = []+ recurse n [] = replicate n (varE rec_name)+ recurse n args' = [varE rec_name `appEs` es | es <- take n args']++ rec_name = recursiveName gen name+++nameGens :: [(Name, [[Char] -> [Char]])]+nameGens =+ [+ ('emptyPR, [])+ , ('replicatePR, [const "n#", id])+ , ('replicatelPR, [const "segd", id])+ , ('repeatPR, [const "n#", const "len#", id])+ , ('indexPR, [id, const "i#"])+ , ('extractPR, [id, const "i#", const "n#"])+ , ('bpermutePR, [id, const "n#", const "is"])+ , ('appPR, [(++"1"), (++"2")])+ , ('applPR, [const "segd", const "is", (++"1"), const "js", (++"2")])+ , ('packByTagPR, [id, const "n#", const "tags", const "t#"])+ , ('combine2PR, [const "n#", const "sel", (++"1"), (++"2")])+ , ('updatePR, [(++"1"), const "is", (++"2")])+ , ('fromListPR, [const "n#", id])+ , ('nfPR, [id])+ ]++-- ---------------+-- Scalar types+-- ---------------++scalarInstances :: [Name] -> Q [Dec]+scalarInstances tys+ = do+ pdatas <- mapM instance_PData_scalar tys+ scalars <- mapM instance_Scalar_scalar tys+ prs <- mapM instance_PR_scalar tys+ return $ pdatas ++ scalars ++ prs++pdataScalarCon :: Name -> Name+pdataScalarCon n = mkName ("P" ++ nameBase n)++instance_PData_scalar :: Name -> DecQ+instance_PData_scalar tycon+ = newtype_instance_PData tycon [] (pdataScalarCon tycon)+ (conT ''U.Array `appT` conT tycon)++instance_Scalar_scalar :: Name -> DecQ+instance_Scalar_scalar ty+ = instanceD (cxt [])+ (conT ''Scalar `appT` conT ty)+ (map (inlineD . mkName . fst) methods ++ map snd methods)+ where+ pcon = pdataScalarCon ty+ xs = mkName "xs"++ methods = [("fromScalarPData", mk_fromScalarPData),+ ("toScalarPData", mk_toScalarPData)]++ mk_fromScalarPData = simpleFunD (mkName "fromScalarPData")+ [conP pcon [varP xs]]+ (varE xs)+ mk_toScalarPData = simpleFunD (mkName "toScalarPData") [] (conE pcon)++instance_PR_scalar :: Name -> DecQ+instance_PR_scalar ty+ = do+ methods <- genPR_methods (scalarMethod ty)+ return $ InstanceD []+ (ConT ''PR `AppT` ConT ty)+ methods++scalarMethod :: Name -> Name -> [ArgVal] -> Val -> DecQ+scalarMethod _ meth _ _+ = simpleFunD (mkName $ nameBase meth) []+ $ varE+ $ mkName (nameBase meth ++ "Scalar")++{-+ = simpleFunD (mkName $ nameBase meth) pats+ $ result res+ $ varE impl `appEs` vals+ where+ pcon = pdataPrimCon ty+ impl = mkName+ $ nameBase meth ++ "Prim"++ (pats, vals) = unzip [arg v g | (v,g) <- avs]++ arg ScalarVal g = var (g "x")+ arg PDataVal g = let v = mkName (g "xs")+ in (conP pcon [varP v], varE v)+ arg ListVal g = var (g "xs")+ arg OtherVal g = var (g "")++ var s = let v = mkName s in (varP v, varE v)++ result ScalarVal e = e+ result PDataVal e = conE pcon `appE` e+ result UnitVal e = varE 'seq `appEs` [e, varE '()]+ result OtherVal e = e+-}++-- ----+-- Void+-- ----++voidPRInstance :: Name -> Name -> Name -> Q [Dec]+voidPRInstance ty void pvoid+ = do+ methods <- genPR_methods (voidMethod void pvoid)+ return [InstanceD []+ (ConT ''PR `AppT` ConT ty)+ methods]++voidMethod :: Name -> Name -> Name -> [ArgVal] -> Val -> DecQ+voidMethod void pvoid meth avs res+ = simpleFunD (mkName $ nameBase meth) (map (const wildP) avs)+ $ result res+ where+ result ScalarVal = varE void+ result PDataVal = varE pvoid+ result UnitVal = conE '()+ result _ = error "DPH gen: voidMethod: no match"+ +-- --+-- ()+-- --++unitPRInstance :: Name -> Q [Dec]+unitPRInstance punit+ = do+ methods <- genPR_methods (unitMethod punit)+ return [InstanceD []+ (ConT ''PR `AppT` ConT ''())+ methods]++unitMethod :: Name -> Name -> [ArgVal] -> Val -> DecQ+unitMethod punit meth avs res+ = simpleFunD (mkName $ nameBase meth) pats+ $ foldr seq_val (result res) es+ where+ (pats, es) = unzip [mkpat v g | (v,g) <- avs]++ mkpat ScalarVal _ = (conP '() [], Nothing)+ mkpat PDataVal _ = (conP punit [], Nothing)++ mkpat ListVal g + = let xs = mkName (g "xs")+ in (varP xs, Just $ \e -> varE 'foldr `appEs` [varE 'seq, e, varE xs])++ mkpat OtherVal _ = (wildP, Nothing)+ mkpat _ _ = error "DPH gen: unitMethod/mkpat: no match"++ result ScalarVal = conE '()+ result PDataVal = conE punit+ result UnitVal = conE '()+ result _ = error "DPH gen: unitMethod/result: no match"++ seq_val Nothing e = e+ seq_val (Just f) e = f e++-- ----+-- Wrap+-- ----++wrapPRInstance :: Name -> Name -> Name -> Name -> Q [Dec]+wrapPRInstance ty wrap unwrap pwrap+ = do+ methods <- genPR_methods (recursiveMethod (wrapGen wrap unwrap pwrap))+ return [InstanceD [ClassP ''PA [a]]+ (ConT ''PR `AppT` (ConT ty `AppT` a))+ methods]+ where+ a = VarT (mkName "a")++wrapGen :: Name -> Name -> Name -> Gen+wrapGen wrap unwrap pwrap + = Gen { recursiveCalls = 1+ , recursiveName = recursiveName'+ , split = split'+ , join = join'+ , typeName = "Wrap a"+ }+ where+ recursiveName' = mkName . replace . nameBase+ where+ replace s = init s ++ "D"++ split' (ScalarVal, gen)+ = (PatSplit (conP wrap [varP x]), RecArg [] [varE x])+ where+ x = mkName (gen "x")++ split' (PDataVal, gen)+ = (PatSplit (conP pwrap [varP xs]), RecArg [] [varE xs])+ where+ xs = mkName (gen "xs")++ split' (ListVal, gen)+ = (PatSplit (varP xs),+ RecArg [] [varE 'map `appEs` [varE unwrap, varE xs]])+ where+ xs = mkName (gen "xs")++ split' _ = error "DPH gen: split': no match"+++ join' ScalarVal [x] = conE wrap `appE` x+ join' PDataVal [xs] = conE pwrap `appE` xs+ join' UnitVal [x] = x+ join' _ _ = error "DPH gen: wrapGen: no match"+++-- ------+-- Tuples+-- ------++tupleInstances :: [Int] -> Q [Dec]+tupleInstances ns+ = do+ pdatas <- mapM instance_PData_tup ns+ prs <- mapM instance_PR_tup ns+ return $ pdatas ++ prs++pdataTupCon :: Int -> Name+pdataTupCon n = mkName ("P_" ++ show n)++instance_PData_tup :: Int -> DecQ+instance_PData_tup arity+ = instance_PData (tupleT arity) vars (pdataTupCon arity)+ [conT ''PData `appT` varT v | v <- vars]+ where+ vars = take arity $ [mkName [c] | c <- ['a' .. ]]+++instance_PR_tup :: Int -> DecQ+instance_PR_tup arity+ = do+ methods <- genPR_methods (recursiveMethod (tupGen arity))+ return $ InstanceD [ClassP ''PR [ty] | ty <- tys]+ (ConT ''PR `AppT` (TupleT arity `mkAppTs` tys))+ methods+ where+ tys = take arity $ [VarT $ mkName [c] | c <- ['a' .. ]]++tupGen :: Int -> Gen+tupGen arity = Gen { recursiveCalls = arity+ , recursiveName = id+ , split = split'+ , join = join'+ , typeName = tyname+ }+ where+ split' (ScalarVal, gen)+ = (PatSplit (tupP $ varPs names), RecArg [] (varEs names))+ where+ names = map (mkName . gen) vs++ split' (PDataVal, gen)+ = (PatSplit (conP (pdataTupCon arity) $ varPs names),+ RecArg [] (varEs names))+ where+ names = map (mkName . gen) pvs++ split' (ListVal, gen)+ = (CaseSplit (varP xs) (varE mkunzip `appE` varE xs)+ (tupP $ varPs names),+ RecArg [] (varEs names))+ where+ xs = mkName (gen "xs")+ names = map (mkName . gen) pvs++ mkunzip | arity == 2 = mkName "unzip"+ | otherwise = mkName ("unzip" ++ show arity)+ + split' _ = error "DPH Gen: tupGen/split: no match"+++ join' ScalarVal xs = tupE xs+ join' PDataVal xs = conE (pdataTupCon arity) `appEs` xs+ join' UnitVal xs = foldl1 (\x y -> varE 'seq `appEs` [x,y]) xs+ join' _ _ = error "DPH Gen: tupGen/join: no match"++ vs = take arity [[c] | c <- ['a' ..]]+ pvs = take arity [c : "s" | c <- ['a' ..]]++ tyname = "(" ++ intercalate "," vs ++ ")"+
+ Data/Array/Parallel/Lifted/Unboxed.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE CPP #-}++#include "fusion-phases.h"++module Data.Array.Parallel.Lifted.Unboxed (+ Segd, elementsSegd#, mkSegd#,+ Sel2, elementsSel2_0#, elementsSel2_1#, replicateSel2#, pickSel2#, tagsSel2,++ PArray_Int#,+ lengthPA_Int#, emptyPA_Int#,+ replicatePA_Int#, replicatelPA_Int#, repeatPA_Int#,+ indexPA_Int#, extractPA_Int#, bpermutePA_Int#,+ appPA_Int#, applPA_Int#,+ packPA_Int#, pack'PA_Int#, combine2PA_Int#, combine2'PA_Int#,+ fromListPA_Int#,+ upToPA_Int#, enumFromToPA_Int#, enumFromThenToPA_Int#,+ enumFromStepLenPA_Int#,+ selectPA_Int#, selectorToIndices2PA#,+ -- lengthSegdPA#, lengthsSegdPA#, indicesSegdPA#, elementsSegdPA#,+ -- lengthsToSegdPA#, mkSegdPA#,+ sumPA_Int#, sumPAs_Int#,+ unsafe_mapPA_Int#, unsafe_zipWithPA_Int#, unsafe_foldPA_Int#,+ unsafe_scanPA_Int#,++ PArray_Word8#,+ lengthPA_Word8#, emptyPA_Word8#,+ replicatePA_Word8#, replicatelPA_Word8#, repeatPA_Word8#,+ indexPA_Word8#, extractPA_Word8#, bpermutePA_Word8#,+ appPA_Word8#, applPA_Word8#,+ packPA_Word8#, pack'PA_Word8#, combine2PA_Word8#, combine2'PA_Word8#,+ fromListPA_Word8#,+ unsafe_zipWithPA_Word8#, unsafe_foldPA_Word8#, unsafe_fold1PA_Word8#,+ unsafe_foldPAs_Word8#,++ PArray_Double#,+ lengthPA_Double#, emptyPA_Double#,+ replicatePA_Double#, replicatelPA_Double#, repeatPA_Double#,+ indexPA_Double#, extractPA_Double#, bpermutePA_Double#,+ appPA_Double#, applPA_Double#,+ packPA_Double#, pack'PA_Double#, combine2PA_Double#, combine2'PA_Double#,+ fromListPA_Double#,+ unsafe_zipWithPA_Double#, unsafe_foldPA_Double#, unsafe_fold1PA_Double#,+ unsafe_foldPAs_Double#,++ PArray_Bool#,+ lengthPA_Bool#, replicatelPA_Bool#,+ packPA_Bool#, truesPA_Bool#, truesPAs_Bool#,++ fromBoolPA#, toBoolPA#+) where++import qualified Data.Array.Parallel.Unlifted as U+import Data.Array.Parallel.Base (+ Tag, fromBool, toBool, intToTag, tagToInt )++import GHC.Exts ( Int#, Int(..), Word#,+ Double#, Double(..) )+import GHC.Word ( Word8(..) )++type Segd = U.Segd+type Sel2 = U.Sel2++elementsSegd# :: Segd -> Int#+elementsSegd# segd = case U.elementsSegd segd of { I# n# -> n# }+{-# INLINE_PA elementsSegd# #-}++mkSegd# :: U.Array Int -> U.Array Int -> Int# -> Segd+mkSegd# ns is n# = U.mkSegd ns is (I# n#)+{-# INLINE_PA mkSegd# #-}++{-# RULES++"mkSegd#" forall ns is n#.+ mkSegd# ns is n# = U.mkSegd ns is (I# n#)++ #-}++replicateSel2# :: Int# -> Int# -> Sel2+{-# INLINE replicateSel2# #-}+replicateSel2# n# tag# = U.mkSel2 (U.replicate n (intToTag tag))+ (U.enumFromStepLen 0 1 n)+ (if tag == 0 then n else 0)+ (if tag == 0 then 0 else n)+ (U.mkSelRep2 (U.replicate n (intToTag tag)))+ where+ n = I# n#+ tag = I# tag#++pickSel2# :: Sel2 -> Int# -> U.Array Bool+{-# INLINE pickSel2# #-}+pickSel2# sel tag# = U.pick (U.tagsSel2 sel) (intToTag (I# tag#))++tagsSel2 :: Sel2 -> U.Array Tag+{-# INLINE tagsSel2 #-}+tagsSel2 = U.tagsSel2++elementsSel2_0# :: Sel2 -> Int#+elementsSel2_0# sel = case U.elementsSel2_0 sel of { I# n# -> n# }+{-# INLINE_PA elementsSel2_0# #-}++elementsSel2_1# :: Sel2 -> Int#+elementsSel2_1# sel = case U.elementsSel2_1 sel of { I# n# -> n# }+{-# INLINE_PA elementsSel2_1# #-}++type PArray_Int# = U.Array Int++lengthPA_Int# :: PArray_Int# -> Int#+lengthPA_Int# arr = case U.length arr of { I# n# -> n# }+{-# INLINE_PA lengthPA_Int# #-}++emptyPA_Int# :: PArray_Int#+emptyPA_Int# = U.empty+{-# INLINE_PA emptyPA_Int# #-}++replicatePA_Int# :: Int# -> Int# -> PArray_Int#+replicatePA_Int# n# i# = U.replicate (I# n#) (I# i#)+{-# INLINE_PA replicatePA_Int# #-}++{-# RULES++"replicatePA_Int#" forall n# i#.+ replicatePA_Int# n# i# = U.replicate (I# n#) (I# i#)++ #-}++replicatelPA_Int# :: Segd -> PArray_Int# -> PArray_Int#+replicatelPA_Int# segd is = U.replicate_s segd is+{-# INLINE_PA replicatelPA_Int# #-}++{-# RULES++"replicatelPA_Int#" forall segd is.+ replicatelPA_Int# segd is = U.replicate_s segd is++ #-}++repeatPA_Int# :: Int# -> Int# -> PArray_Int# -> PArray_Int#+repeatPA_Int# n# len# is = U.repeat (I# n#) (I# len#) is+{-# INLINE_PA repeatPA_Int# #-}++indexPA_Int# :: PArray_Int# -> Int# -> Int#+indexPA_Int# ns i# = case ns U.!: I# i# of { I# n# -> n# }+{-# INLINE_PA indexPA_Int# #-}++extractPA_Int# :: PArray_Int# -> Int# -> Int# -> PArray_Int#+extractPA_Int# xs i# n# = U.extract xs (I# i#) (I# n#)+{-# INLINE_PA extractPA_Int# #-}++bpermutePA_Int# :: PArray_Int# -> PArray_Int# -> PArray_Int#+bpermutePA_Int# ns is = U.bpermute ns is+{-# INLINE_PA bpermutePA_Int# #-}++appPA_Int# :: PArray_Int# -> PArray_Int# -> PArray_Int#+appPA_Int# ms ns = ms U.+:+ ns+{-# INLINE_PA appPA_Int# #-}++applPA_Int# :: Segd -> Segd -> PArray_Int# -> Segd -> PArray_Int# -> PArray_Int#+applPA_Int# segd is xs js ys = U.append_s segd is xs js ys+{-# INLINE_PA applPA_Int# #-}++pack'PA_Int# :: PArray_Int# -> PArray_Bool# -> PArray_Int#+pack'PA_Int# ns bs = U.pack ns bs+{-# INLINE_PA pack'PA_Int# #-}++packPA_Int# :: PArray_Int# -> Int# -> PArray_Bool# -> PArray_Int#+packPA_Int# ns _ bs = pack'PA_Int# ns bs+{-# INLINE_PA packPA_Int# #-}++combine2'PA_Int# :: PArray_Int# -> PArray_Int# -> PArray_Int# -> PArray_Int#+combine2'PA_Int# sel xs ys = U.combine (U.map (== 0) sel) xs ys+{-# INLINE_PA combine2'PA_Int# #-}++combine2PA_Int# :: Int# -> PArray_Int# -> PArray_Int#+ -> PArray_Int# -> PArray_Int# -> PArray_Int#+combine2PA_Int# _ sel _ xs ys = combine2'PA_Int# sel xs ys+{-# INLINE_PA combine2PA_Int# #-}++fromListPA_Int# :: Int# -> [Int] -> PArray_Int#+fromListPA_Int# _ xs = U.fromList xs+{-# INLINE_PA fromListPA_Int# #-}++upToPA_Int# :: Int# -> PArray_Int#+upToPA_Int# n# = U.enumFromTo 0 (I# n# - 1)+{-# INLINE_PA upToPA_Int# #-}++enumFromToPA_Int# :: Int# -> Int# -> PArray_Int#+enumFromToPA_Int# m# n# = U.enumFromTo (I# m#) (I# n#)+{-# INLINE_PA enumFromToPA_Int# #-}++enumFromThenToPA_Int# :: Int# -> Int# -> Int# -> PArray_Int#+enumFromThenToPA_Int# k# m# n# = U.enumFromThenTo (I# k#) (I# m#) (I# n#)+{-# INLINE_PA enumFromThenToPA_Int# #-}++enumFromStepLenPA_Int# :: Int# -> Int# -> Int# -> PArray_Int#+enumFromStepLenPA_Int# k# m# n# = U.enumFromStepLen (I# k#) (I# m#) (I# n#)+{-# INLINE_PA enumFromStepLenPA_Int# #-}++selectPA_Int# :: PArray_Int# -> Int# -> PArray_Bool#+selectPA_Int# ns i# = U.map (\n -> n == I# i#) ns+{-# INLINE_PA selectPA_Int# #-}+++selectorToIndices2PA# :: PArray_Int# -> PArray_Int#+selectorToIndices2PA# sel+ = U.zipWith pick sel+ . U.scan index (0,0)+ $ U.map init' sel+ where+ init' 0 = (1,0)+ init' _ = (0,1)++ index (i1,j1) (i2,j2) = (i1+i2,j1+j2)++ pick 0 (i,_) = i+ pick _ (_,j) = j+{-# INLINE_PA selectorToIndices2PA# #-}++sumPA_Int# :: PArray_Int# -> Int#+sumPA_Int# ns = case U.sum ns of I# n# -> n#+{-# INLINE_PA sumPA_Int# #-}++sumPAs_Int# :: Segd -> PArray_Int# -> PArray_Int#+sumPAs_Int# segd ds = U.sum_s segd ds+{-# INLINE_PA sumPAs_Int# #-}++unsafe_mapPA_Int# :: (Int -> Int) -> PArray_Int# -> PArray_Int#+unsafe_mapPA_Int# f ns = U.map f ns+{-# INLINE_PA unsafe_mapPA_Int# #-}++unsafe_zipWithPA_Int# :: (Int -> Int -> Int)+ -> PArray_Int# -> PArray_Int# -> PArray_Int#+unsafe_zipWithPA_Int# f ms ns = U.zipWith f ms ns+{-# INLINE_PA unsafe_zipWithPA_Int# #-}++unsafe_foldPA_Int# :: (Int -> Int -> Int) -> Int -> PArray_Int# -> Int+unsafe_foldPA_Int# f z ns = U.fold f z ns+{-# INLINE_PA unsafe_foldPA_Int# #-}++unsafe_scanPA_Int# :: (Int -> Int -> Int) -> Int -> PArray_Int# -> PArray_Int#+unsafe_scanPA_Int# f z ns = U.scan f z ns+{-# INLINE_PA unsafe_scanPA_Int# #-}++type PArray_Word8# = U.Array Word8++lengthPA_Word8# :: PArray_Word8# -> Int#+lengthPA_Word8# arr = case U.length arr of { I# n# -> n# }+{-# INLINE_PA lengthPA_Word8# #-}++emptyPA_Word8# :: PArray_Word8#+emptyPA_Word8# = U.empty+{-# INLINE_PA emptyPA_Word8# #-}++replicatePA_Word8# :: Int# -> Word# -> PArray_Word8#+replicatePA_Word8# n# d# = U.replicate (I# n#) (W8# d#)+{-# INLINE_PA replicatePA_Word8# #-}++replicatelPA_Word8# :: Segd -> PArray_Word8# -> PArray_Word8#+replicatelPA_Word8# segd ds = U.replicate_s segd ds+{-# INLINE_PA replicatelPA_Word8# #-}++repeatPA_Word8# :: Int# -> Int# -> PArray_Word8# -> PArray_Word8#+repeatPA_Word8# n# len# ds = U.repeat (I# n#) (I# len#) ds+{-# INLINE_PA repeatPA_Word8# #-}++indexPA_Word8# :: PArray_Word8# -> Int# -> Word#+indexPA_Word8# ds i# = case ds U.!: I# i# of { W8# d# -> d# }+{-# INLINE_PA indexPA_Word8# #-}++extractPA_Word8# :: PArray_Word8# -> Int# -> Int# -> PArray_Word8#+extractPA_Word8# xs i# n# = U.extract xs (I# i#) (I# n#)+{-# INLINE_PA extractPA_Word8# #-}++bpermutePA_Word8# :: PArray_Word8# -> PArray_Int# -> PArray_Word8#+bpermutePA_Word8# ds is = U.bpermute ds is+{-# INLINE_PA bpermutePA_Word8# #-}++appPA_Word8# :: PArray_Word8# -> PArray_Word8# -> PArray_Word8#+appPA_Word8# ms ns = ms U.+:+ ns+{-# INLINE_PA appPA_Word8# #-}++applPA_Word8# :: Segd -> Segd -> PArray_Word8# -> Segd -> PArray_Word8#+ -> PArray_Word8#+applPA_Word8# segd is xs js ys = U.append_s segd is xs js ys+{-# INLINE_PA applPA_Word8# #-}++pack'PA_Word8# :: PArray_Word8# -> PArray_Bool# -> PArray_Word8#+pack'PA_Word8# ns bs = U.pack ns bs+{-# INLINE_PA pack'PA_Word8# #-}++packPA_Word8# :: PArray_Word8# -> Int# -> PArray_Bool# -> PArray_Word8#+packPA_Word8# ns _ bs = pack'PA_Word8# ns bs+{-# INLINE_PA packPA_Word8# #-}++combine2'PA_Word8# :: PArray_Int#+ -> PArray_Word8# -> PArray_Word8# -> PArray_Word8#+combine2'PA_Word8# sel xs ys = U.combine (U.map (== 0) sel) xs ys+{-# INLINE_PA combine2'PA_Word8# #-}++combine2PA_Word8# :: Int# -> PArray_Int# -> PArray_Int#+ -> PArray_Word8# -> PArray_Word8# -> PArray_Word8#+combine2PA_Word8# _ sel _ xs ys = combine2'PA_Word8# sel xs ys+{-# INLINE_PA combine2PA_Word8# #-}++fromListPA_Word8# :: Int# -> [Word8] -> PArray_Word8#+fromListPA_Word8# _ xs = U.fromList xs+{-# INLINE_PA fromListPA_Word8# #-}++unsafe_zipWithPA_Word8# :: (Word8 -> Word8 -> Word8)+ -> PArray_Word8# -> PArray_Word8# -> PArray_Word8#+unsafe_zipWithPA_Word8# f ms ns = U.zipWith f ms ns+{-# INLINE_PA unsafe_zipWithPA_Word8# #-}++unsafe_foldPA_Word8# :: (Word8 -> Word8 -> Word8)+ -> Word8 -> PArray_Word8# -> Word8+unsafe_foldPA_Word8# f z ns = U.fold f z ns+{-# INLINE_PA unsafe_foldPA_Word8# #-}++unsafe_fold1PA_Word8#+ :: (Word8 -> Word8 -> Word8) -> PArray_Word8# -> Word8+unsafe_fold1PA_Word8# f ns = U.fold1 f ns+{-# INLINE_PA unsafe_fold1PA_Word8# #-}++unsafe_foldPAs_Word8# :: (Word8 -> Word8 -> Word8) -> Word8+ -> Segd -> PArray_Word8# -> PArray_Word8#+unsafe_foldPAs_Word8# f z segd ds = U.fold_s f z segd ds+{-# INLINE_PA unsafe_foldPAs_Word8# #-}++type PArray_Double# = U.Array Double++lengthPA_Double# :: PArray_Double# -> Int#+lengthPA_Double# arr = case U.length arr of { I# n# -> n# }+{-# INLINE_PA lengthPA_Double# #-}++emptyPA_Double# :: PArray_Double#+emptyPA_Double# = U.empty+{-# INLINE_PA emptyPA_Double# #-}++replicatePA_Double# :: Int# -> Double# -> PArray_Double#+replicatePA_Double# n# d# = U.replicate (I# n#) (D# d#)+{-# INLINE_PA replicatePA_Double# #-}++replicatelPA_Double# :: Segd -> PArray_Double# -> PArray_Double#+replicatelPA_Double# segd ds = U.replicate_s segd ds+{-# INLINE_PA replicatelPA_Double# #-}++repeatPA_Double# :: Int# -> Int# -> PArray_Double# -> PArray_Double#+repeatPA_Double# n# len# ds = U.repeat (I# n#) (I# len#) ds+{-# INLINE_PA repeatPA_Double# #-}++{-# RULES++"repeatPA_Double#" forall n# len# ds.+ repeatPA_Double# n# len# ds = U.repeat (I# n#) (I# len#) ds++ #-}++indexPA_Double# :: PArray_Double# -> Int# -> Double#+indexPA_Double# ds i# = case ds U.!: I# i# of { D# d# -> d# }+{-# INLINE_PA indexPA_Double# #-}++extractPA_Double# :: PArray_Double# -> Int# -> Int# -> PArray_Double#+extractPA_Double# xs i# n# = U.extract xs (I# i#) (I# n#)+{-# INLINE_PA extractPA_Double# #-}++bpermutePA_Double# :: PArray_Double# -> PArray_Int# -> PArray_Double#+bpermutePA_Double# ds is = U.bpermute ds is+{-# INLINE_PA bpermutePA_Double# #-}++appPA_Double# :: PArray_Double# -> PArray_Double# -> PArray_Double#+appPA_Double# ms ns = ms U.+:+ ns+{-# INLINE_PA appPA_Double# #-}++applPA_Double# :: Segd -> Segd -> PArray_Double# -> Segd -> PArray_Double#+ -> PArray_Double#+applPA_Double# segd is xs js ys = U.append_s segd is xs js ys+{-# INLINE_PA applPA_Double# #-}++pack'PA_Double# :: PArray_Double# -> PArray_Bool# -> PArray_Double#+pack'PA_Double# ns bs = U.pack ns bs+{-# INLINE_PA pack'PA_Double# #-}++packPA_Double# :: PArray_Double# -> Int# -> PArray_Bool# -> PArray_Double#+packPA_Double# ns _ bs = pack'PA_Double# ns bs+{-# INLINE_PA packPA_Double# #-}++combine2'PA_Double# :: PArray_Int#+ -> PArray_Double# -> PArray_Double# -> PArray_Double#+combine2'PA_Double# sel xs ys = U.combine (U.map (== 0) sel) xs ys+{-# INLINE_PA combine2'PA_Double# #-}++combine2PA_Double# :: Int# -> PArray_Int# -> PArray_Int#+ -> PArray_Double# -> PArray_Double# -> PArray_Double#+combine2PA_Double# _ sel _ xs ys = combine2'PA_Double# sel xs ys+{-# INLINE_PA combine2PA_Double# #-}++fromListPA_Double# :: Int# -> [Double] -> PArray_Double#+fromListPA_Double# _ xs = U.fromList xs+{-# INLINE_PA fromListPA_Double# #-}++unsafe_zipWithPA_Double# :: (Double -> Double -> Double)+ -> PArray_Double# -> PArray_Double# -> PArray_Double#+unsafe_zipWithPA_Double# f ms ns = U.zipWith f ms ns+{-# INLINE_PA unsafe_zipWithPA_Double# #-}++unsafe_foldPA_Double# :: (Double -> Double -> Double)+ -> Double -> PArray_Double# -> Double+unsafe_foldPA_Double# f z ns = U.fold f z ns+{-# INLINE_PA unsafe_foldPA_Double# #-}++unsafe_fold1PA_Double#+ :: (Double -> Double -> Double) -> PArray_Double# -> Double+unsafe_fold1PA_Double# f ns = U.fold1 f ns+{-# INLINE_PA unsafe_fold1PA_Double# #-}++unsafe_foldPAs_Double# :: (Double -> Double -> Double) -> Double+ -> Segd -> PArray_Double# -> PArray_Double#+unsafe_foldPAs_Double# f z segd ds = U.fold_s f z segd ds+{-# INLINE_PA unsafe_foldPAs_Double# #-}+ +type PArray_Bool# = U.Array Bool++lengthPA_Bool# :: PArray_Bool# -> Int#+lengthPA_Bool# arr = case U.length arr of { I# n# -> n# }+{-# INLINE_PA lengthPA_Bool# #-}++replicatelPA_Bool# :: Segd -> PArray_Bool# -> PArray_Bool#+replicatelPA_Bool# segd ds = U.replicate_s segd ds+{-# INLINE_PA replicatelPA_Bool# #-}++packPA_Bool# :: PArray_Bool# -> Int# -> PArray_Bool# -> PArray_Bool#+packPA_Bool# ns _ bs = U.pack ns bs+{-# INLINE_PA packPA_Bool# #-}++truesPA_Bool# :: PArray_Bool# -> Int#+truesPA_Bool# bs = sumPA_Int# (fromBoolPA# bs)+{-# INLINE_PA truesPA_Bool# #-}++truesPAs_Bool# :: Segd -> PArray_Bool# -> PArray_Int#+truesPAs_Bool# segd = sumPAs_Int# segd . fromBoolPA#+{-# INLINE truesPAs_Bool# #-}++fromBoolPA# :: PArray_Bool# -> PArray_Int#+fromBoolPA# = U.map (tagToInt . fromBool)+{-# INLINE_PA fromBoolPA# #-}++toBoolPA# :: PArray_Int# -> PArray_Bool#+toBoolPA# = U.map (toBool . intToTag)+{-# INLINE_PA toBoolPA# #-}+
+ Data/Array/Parallel/PArr.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE ParallelArrays, UnboxedTuples, MagicHash #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+{-# OPTIONS_HADDOCK hide #-}++-- #hide+module Data.Array.Parallel.PArr (+ emptyPArr, replicatePArr, singletonPArr, indexPArr, lengthPArr+) where++import GHC.ST ( ST(..), runST )+import GHC.Base ( Array#, Int (I#), MutableArray#, newArray#,+ unsafeFreezeArray#, indexArray#, {- writeArray# -} )+import GHC.PArr -- provides the definition of '[::]'++emptyPArr :: [:a:]+{-# NOINLINE emptyPArr #-}+emptyPArr = replicatePArr 0 undefined++replicatePArr :: Int -> a -> [:a:]+{-# NOINLINE replicatePArr #-}+replicatePArr n e = runST (do+ marr# <- newArray n e+ mkPArr n marr#)++singletonPArr :: a -> [:a:]+{-# NOINLINE singletonPArr #-}+singletonPArr e = replicatePArr 1 e++indexPArr :: [:e:] -> Int -> e+{-# NOINLINE indexPArr #-}+indexPArr (PArr n arr#) i@(I# i#)+ | i >= 0 && i < n =+ case indexArray# arr# i# of (# e #) -> e+ | otherwise = error $ "indexPArr: out of bounds parallel array index; " +++ "idx = " ++ show i ++ ", arr len = "+ ++ show n++lengthPArr :: [:a:] -> Int+{-# NOINLINE lengthPArr #-}+lengthPArr (PArr n _) = n++-- auxiliary functions+-- -------------------++-- internally used mutable boxed arrays+--+data MPArr s e = MPArr !Int (MutableArray# s e)++-- allocate a new mutable array that is pre-initialised with a given value+--+newArray :: Int -> e -> ST s (MPArr s e)+{-# INLINE newArray #-}+newArray n@(I# n#) e = ST $ \s1# ->+ case newArray# n# e s1# of { (# s2#, marr# #) ->+ (# s2#, MPArr n marr# #)}++-- convert a mutable array into the external parallel array representation+--+mkPArr :: Int -> MPArr s e -> ST s [:e:]+{-# INLINE mkPArr #-}+mkPArr n (MPArr _ marr#) = ST $ \s1# ->+ case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->+ (# s2#, PArr n arr# #) }
+ Data/Array/Parallel/PArray.hs view
@@ -0,0 +1,245 @@++-- | Parallel Arrays.+--+-- Parallel arrays use a fixed generic representation. All data stored in+-- them is converted to the generic representation, and we have a small+-- number of operators that work on arrays of these generic types.+--+-- Representation types include Ints, Floats, Tuples and Sums, so arrays of+-- these types can be stored directly. However, user defined algebraic data+-- needs to be converted as we don't have operators that work directly on+-- arrays of these types.+--+-- The top-level PArray type is built up from several type families and+-- clases:+--+-- PArray - This is the top level type. It holds an array length, +-- and array data in the generic representation (PData).+--+-- PRepr - Family of types that can be converted to the generic+-- representation. We supply instances for basic types+-- like Ints Floats etc, but the vectoriser needs to make+-- the instances for user-defined data types itself.+-- PA class - Contains methods to convert to and from the generic+-- representation (PData).+-- +-- PData - Family of types that can be stored directly in parallel+-- arrays. We supply all the PData instances we need here+-- in the library.+-- PR class - Contains methods that work directly on parallel arrays.+-- Most of these are just wrappers for the corresponding+-- U.Array operators.+--+-- Scalar class - Contains methods to convert between the generic +-- representation (PData) and plain U.Arrays.+--+-- Note that the PRepr family and PA class are related.+-- so are the PData family and PR class.+--+-- For motivational material see:+-- "An Approach to Fast Arrays in Haskell", Chakravarty and Keller, 2003+--+-- For discussion of how the mapping to generic types works see:+-- "Instant Generics: Fast and Easy", Chakravarty, Ditu and Keller, 2009+--+module Data.Array.Parallel.PArray (+ PArray, PA, Random(..),++ -- * Array operators.+ length,+ empty,+ replicate,+ singleton,+ (!:),+ zip, unzip,+ pack,+ concat, (+:+),+ indexed,+ slice,+ update,+ bpermute,+ enumFromTo,+ + -- * Conversion+ fromList, + toList,+ fromUArrPA',+ + -- * Evaluation+ nf+) +where+import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.PArray.PReprInstances ()+import Data.Array.Parallel.Lifted.Combinators+import Data.Array.Parallel.Lifted.Scalar+import qualified Data.Array.Parallel.Unlifted as U++import Data.Array.Parallel.Base ( showsApp )++import qualified System.Random as R++import Prelude hiding ( length, replicate, zip, unzip, enumFromTo, concat )++-- NOTE: +-- Most of these functions just export the corresponding "vectorised" +-- function from "Data.Array.Parallel.Lifted.Closure". We don't export+-- higher-order functions like map and filter because the versions +-- from there want closures as their function parameters.+--+-- Instead, we should probably move the first-order "vectorised" +-- functions from D.A.P.L.Closure into this module, and just define+-- the higher-order and lifted ones there.+--+-- We still want to export these plain PArray functions to make it easier+-- to convert between vectorised and unvectorised code in benchmarks.+--++-- | O(1). An empty array, with no elements.+empty :: PA a => PArray a+{-# INLINE empty #-}+empty = emptyPA+++-- | O(1). Retrieve a numbered element from an array.+(!:) :: PA a => PArray a -> Int -> a+{-# INLINE (!:) #-}+(!:) = indexPA_v+++-- | O(1). Yield the length of an array.+length :: PA a => PArray a -> Int+{-# INLINE length #-}+length = lengthPA_v+++-- | O(n). Produce an array containing copies of a given element.+replicate :: PA a => Int -> a -> PArray a+{-# INLINE replicate #-}+replicate = replicatePA_v+++-- | O(1). Produce an array containing a single element.+singleton :: PA a => a -> PArray a+{-# INLINE singleton #-}+singleton = singletonPA_v+++-- | O(1). Takes two arrays and returns an array of corresponding pairs.+-- If one array is short, excess elements of the longer array are+-- discarded.+zip :: (PA a, PA b) => PArray a -> PArray b -> PArray (a,b)+{-# INLINE zip #-}+zip = zipPA_v+++-- | O(1). Transform an array into an array of the first components,+-- and an array of the second components.+unzip :: (PA a, PA b) => PArray (a,b) -> (PArray a, PArray b)+{-# INLINE unzip #-}+unzip = unzipPA_v+++-- | Select the elements of an array that have their tag set as True.+-- +-- @+-- packPA [12, 24, 42, 93] [True, False, False, True]+-- = [24, 42]+-- @+pack :: PA a => PArray a -> PArray Bool -> PArray a+{-# INLINE pack #-}+pack = packPA_v++++-- | Concatenate an array of arrays into a single array.+concat :: PA a => PArray (PArray a) -> PArray a+{-# INLINE concat #-}+concat = concatPA_v+++-- | Append two arrays+(+:+) :: PA a => PArray a -> PArray a -> PArray a+{-# INLINE (+:+) #-}+(+:+) = appPA_v+++-- | O(n). Tag each element of an array with its index.+--+-- @indexed [42, 93, 13] = [(0, 42), (1, 93), (2, 13)]@ +--+indexed :: PA a => PArray a -> PArray (Int, a)+{-# INLINE indexed #-}+indexed = indexedPA_v+++-- | Extract a subrange of elements from an array.+-- The first argument is the starting index, while the second is the +-- length of the slice.+-- +slice :: PA a => Int -> Int -> PArray a -> PArray a+{-# INLINE slice #-}+slice = slicePA_v+++-- | Copy the source array in the destination, using new values for the given indices.+update :: PA a => PArray a -> PArray (Int,a) -> PArray a+{-# INLINE update #-}+update = updatePA_v+++-- | O(n). Backwards permutation of array elements.+--+-- @bpermute [50, 60, 20, 30] [0, 3, 2] = [50, 30, 20]@+--+bpermute :: PA a => PArray a -> PArray Int -> PArray a+{-# INLINE bpermute #-}+bpermute = bpermutePA_v+++-- | O(n). Generate a range of @Int@s.+enumFromTo :: Int -> Int -> PArray Int+{-# INLINE enumFromTo #-}+enumFromTo = enumFromToPA_v+++-- Conversion -----------------------------------------------------------------+-- | Create a `PArray` from a list.+fromList :: PA a => [a] -> PArray a+{-# INLINE fromList #-}+fromList = fromListPA++-- | Create a list from a `PArray`.+toList :: PA a => PArray a -> [a]+toList xs = [indexPA_v xs i | i <- [0 .. length xs - 1]]+++instance (PA a, Show a) => Show (PArray a) where+ showsPrec n xs = showsApp n "fromList<PArray>" (toList xs)+++-- Evaluation -----------------------------------------------------------------+-- | Ensure an array is fully evaluated.+nf :: PA a => PArray a -> ()+nf = nfPA+++-- Randoms --------------------------------------------------------------------+class Random a where+ randoms :: R.RandomGen g => Int -> g -> PArray a+ randomRs :: R.RandomGen g => Int -> (a, a) -> g -> PArray a++prim_randoms :: (Scalar a, R.Random a, R.RandomGen g) => Int -> g -> PArray a+prim_randoms n = fromUArrPA' . U.randoms n++prim_randomRs :: (Scalar a, R.Random a, R.RandomGen g) => Int -> (a, a) -> g -> PArray a+prim_randomRs n r = fromUArrPA' . U.randomRs n r++instance Random Int where+ randoms = prim_randoms+ randomRs = prim_randomRs++instance Random Double where+ randoms = prim_randoms+ randomRs = prim_randomRs+
+ Data/Array/Parallel/PArray/Base.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE CPP, FlexibleContexts #-}++#include "fusion-phases.h"++-- | Definition of the PArray type, and functions that work on it. The PArray+-- type is a PData with an array length. The functions we export from this+-- module are just wrappers for the PD functions from Data.Array.Parallel.PArray.PRepr.+--+-- TODO: Check inconsistent use of INLINE pragmas.+-- Most have INLINE_PA, but bpermutePD and nfPD have plain INLINE+--+module Data.Array.Parallel.PArray.Base (+ PArray(..),+ lengthPA#,+ dataPA#,++ -- These functions have corresponding members in the PR class+ -- from Data.Array.Parallel.PArray.PData.+ emptyPA,+ replicatePA#,+ replicatelPA#,+ repeatPA#,+ indexPA#,+ extractPA#,+ bpermutePA#,+ appPA#,+ applPA#,+ packByTagPA#,+ combine2PA#,+ updatePA#,+ fromListPA#, fromListPA,+ nfPA,+)+where+import Data.Array.Parallel.Lifted.Unboxed (elementsSegd#)+import Data.Array.Parallel.PArray.PData+import Data.Array.Parallel.PArray.PRepr+import Data.Array.Parallel.Base (Tag)+import qualified Data.Array.Parallel.Unlifted as U+import GHC.Exts (Int#, Int(..), (+#), (*#))+import SpecConstr+++-- | Lifted\/bulk parallel arrays+-- This contains the array length, along with the element data.+--+{-# ANN type PArray NoSpecConstr #-}+data PArray a = PArray Int# (PData a)+++-- | Take the length field of a PArray.+lengthPA# :: PArray a -> Int#+{-# INLINE_PA lengthPA# #-}+lengthPA# (PArray n# _) = n#++-- | Take the data field of a PArray.+dataPA# :: PArray a -> PData a+{-# INLINE_PA dataPA# #-}+dataPA# (PArray _ d) = d+++-- PA Wrappers ----------------------------------------------------------------+-- These wrappers work on PArrays. As the PArray contains a PData, we can +-- can just pass this to the corresponding PD function from +-- Data.Array.Parallel.PArray.PRepr. However, as a PData doesn't contain +-- the array length, we need to do the length calculations here.+--+-- Note: There are some more operator# functions that work on PArrays in +-- "Data.Array.Parallel.PArray.DataInstances". The ones there have +-- a similar shape but need to know about the underlying representation+-- constructors.+-- +emptyPA :: PA a => PArray a+{-# INLINE_PA emptyPA #-}+emptyPA+ = PArray 0# emptyPD++replicatePA# :: PA a => Int# -> a -> PArray a+{-# INLINE_PA replicatePA# #-}+replicatePA# n# x+ = PArray n# (replicatePD n# x)++replicatelPA# :: PA a => U.Segd -> PArray a -> PArray a+{-# INLINE_PA replicatelPA# #-}+replicatelPA# segd (PArray _ xs)+ = PArray (elementsSegd# segd) (replicatelPD segd xs)++repeatPA# :: PA a => Int# -> PArray a -> PArray a+{-# INLINE_PA repeatPA# #-}+repeatPA# m# (PArray n# xs) + = PArray (m# *# n#) (repeatPD m# n# xs)++indexPA# :: PA a => PArray a -> Int# -> a+{-# INLINE_PA indexPA# #-}+indexPA# (PArray _ xs) i# + = indexPD xs i#++extractPA# :: PA a => PArray a -> Int# -> Int# -> PArray a+{-# INLINE_PA extractPA# #-}+extractPA# (PArray _ xs) i# n#+ = PArray n# (extractPD xs i# n#)++bpermutePA# :: PA a => PArray a -> Int# -> U.Array Int -> PArray a+{-# INLINE bpermutePA# #-}+bpermutePA# (PArray _ xs) n# is+ = PArray n# (bpermutePD xs n# is)++appPA# :: PA a => PArray a -> PArray a -> PArray a+{-# INLINE_PA appPA# #-}+appPA# (PArray m# xs) (PArray n# ys)+ = PArray (m# +# n#) (appPD xs ys)++applPA# :: PA a => U.Segd -> U.Segd -> PArray a -> U.Segd -> PArray a -> PArray a+{-# INLINE_PA applPA# #-}+applPA# segd is (PArray m# xs) js (PArray n# ys)+ = PArray (m# +# n#) (applPD segd is xs js ys)++packByTagPA# :: PA a => PArray a -> Int# -> U.Array Tag -> Int# -> PArray a+{-# INLINE_PA packByTagPA# #-}+packByTagPA# (PArray _ xs) n# tags t# + = PArray n# (packByTagPD xs n# tags t#)++combine2PA# :: PA a => Int# -> U.Sel2 -> PArray a -> PArray a -> PArray a+{-# INLINE_PA combine2PA# #-}+combine2PA# n# sel (PArray _ as) (PArray _ bs)+ = PArray n# (combine2PD n# sel as bs)++updatePA# :: PA a => PArray a -> U.Array Int -> PArray a -> PArray a+{-# INLINE_PA updatePA# #-}+updatePA# (PArray n# xs) is (PArray _ ys)+ = PArray n# (updatePD xs is ys)++fromListPA# :: PA a => Int# -> [a] -> PArray a+{-# INLINE_PA fromListPA# #-}+fromListPA# n# xs + = PArray n# (fromListPD n# xs)++fromListPA :: PA a => [a] -> PArray a+{-# INLINE fromListPA #-}+fromListPA xs+ = case length xs of+ I# n# -> fromListPA# n# xs++nfPA :: PA a => PArray a -> ()+{-# INLINE nfPA #-}+nfPA (PArray _ xs) + = nfPD xs+
+ Data/Array/Parallel/PArray/PData.hs view
@@ -0,0 +1,189 @@+-- | Defines the family of types that store parallel array data, +-- and the operators we can apply to it.+--+module Data.Array.Parallel.PArray.PData (+ PData,+ PR(..),++ -- These types have corresponding members in the PR class.+ T_emptyPR,+ T_replicatePR,+ T_replicatelPR,+ T_repeatPR,+ T_indexPR,+ T_extractPR,+ T_bpermutePR,+ T_appPR,+ T_applPR,+ T_packByTagPR,+ T_combine2PR,+ T_updatePR,+ T_fromListPR,+ T_nfPR+)+where +import qualified Data.Array.Parallel.Unlifted as U+import Data.Array.Parallel.Base (Tag)+import GHC.Exts (Int#)+import SpecConstr+++-- | Parallel Data.+-- This is the family of types that store parallel array data.+--+-- PData takes the type of an element and produces the type we use to store+-- an array of those elements. The instances for PData use an efficient+-- representation that depends on the type of elements being stored.+-- For example, an array of pairs is stored as two separate arrays, one for+-- each element type. This lets us avoid storing the intermediate Pair/Tuple+-- constructors and the pointers to the elements.+-- +-- Most of the instances are defined in "Data.Array.Parallel.PArray.Instances",+-- though the instances for function closures are defined in their own module, +-- "Data.Array.Parallel.Lifted.Closure".+--+-- Note that PData is just a flat chunk of memory containing elements, and doesn't+-- include a field giving the length of the array. We use PArray when we want to+-- pass around the array data along with its length.+--+{-# ANN type PData NoSpecConstr #-}+data family PData a+++-- | A PR dictionary contains the primitive functions that operate directly+-- on parallel array data.+-- +-- It's called PR because the functions work on our internal, efficient+-- Representation of the user-level array.+--+class PR a where+ emptyPR :: T_emptyPR a+ replicatePR :: T_replicatePR a+ replicatelPR :: T_replicatelPR a+ repeatPR :: T_repeatPR a+ indexPR :: T_indexPR a+ extractPR :: T_extractPR a+ bpermutePR :: T_bpermutePR a+ appPR :: T_appPR a+ applPR :: T_applPR a+ packByTagPR :: T_packByTagPR a+ combine2PR :: T_combine2PR a+ updatePR :: T_updatePR a+ fromListPR :: T_fromListPR a+ nfPR :: T_nfPR a+++-- Operator Types -------------------------------------------------------------+-- | An empty array.+type T_emptyPR a + = PData a+++-- | Produce an array containing copies of a given element.+type T_replicatePR a+ = Int# -- number of copies \/ elements in resulting array+ -> a -- element to replicate+ -> PData a+++-- | Segmented replicate.+type T_replicatelPR a+ = U.Segd -- segment descriptor of result array+ -> PData a + -> PData a+++-- | Produce an array containing copies of some other array.+type T_repeatPR a+ = Int# -- number of times to repeat+ -> Int# -- length of source array+ -> PData a -- source array+ -> PData a+++-- | Retrieve a numbered element from an array.+type T_indexPR a+ = PData a -- source array+ -> Int# -- index of desired element+ -> a+++-- | Extract a subrange of elements from an array.+--+-- extract [:23, 42, 93, 50, 27:] 1 3 = [:42, 93, 50:]+-- +type T_extractPR a+ = PData a -- source array+ -> Int# -- starting index+ -> Int# -- length of result array+ -> PData a+++-- | Construct a new array by selecting elements from a source array.+--+-- bpermute [:50, 60, 20, 30:] 3 [:0, 3, 2:] = [:50, 30, 20:]+--+type T_bpermutePR a+ = PData a -- source array+ -> Int# -- length of resulting array+ -> U.Array Int -- indices of elements in source array+ -> PData a +++-- | Append two arrays.+type T_appPR a+ = PData a -> PData a -> PData a+++-- | Segmented append.+type T_applPR a+ = U.Segd -- result segd+ -> U.Segd -> PData a -- src segd/data 1+ -> U.Segd -> PData a -- src segd/data 2+ -> PData a+++-- | Select some elements from an array that correspond to a particular tag value+-- and pack them into a new array.+--+-- packByTag [:23, 42, 95, 50, 27, 49:] 3 [:1, 2, 1, 2, 3, 2:] 2 = [:42, 50, 49:]+--+type T_packByTagPR a+ = PData a -- source array+ -> Int# -- length of resulting array+ -> U.Array Tag -- tag values of elements in source array+ -> Int# -- tag value of the elements to select+ -> PData a+++-- | Combine two arrays based on a selector+-- The selector says which source array to choose for each element of the+-- resulting array.+type T_combine2PR a+ = Int# -- length of resulting array+ -> U.Sel2 -- selector+ -> PData a -- first source array+ -> PData a -- second source array+ -> PData a+++-- | Copy an array, but update the values of some of the elements in the result.+type T_updatePR a+ = PData a -- source array+ -> U.Array Int -- indices of elements to update+ -> PData a -- new element values. This array should have the+ -- same length as the array of indices+ -> PData a+++-- | Convert a list to an array.+type T_fromListPR a+ = Int# -- length of resulting array+ -> [a] -- source list+ -> PData a+++-- | Force an array to normal form.+type T_nfPR a+ = PData a -> ()+
+ Data/Array/Parallel/PArray/PDataInstances.hs view
@@ -0,0 +1,481 @@+{-# LANGUAGE CPP, TemplateHaskell, EmptyDataDecls #-}+{-# OPTIONS -fno-warn-orphans -fno-warn-missing-methods #-}++#include "fusion-phases.h"++-- | Instances for the PData class+module Data.Array.Parallel.PArray.PDataInstances(+ PData(..),++ pvoid,+ punit,++ -- * Operators on arrays of tuples+ zipPA#, unzipPA#, zip3PA#,+ + -- * Operators on nested arrays+ segdPA#, concatPA#, segmentPA#, copySegdPA#+)+where+import Data.Array.Parallel.PArray.Base+import Data.Array.Parallel.PArray.PData+import Data.Array.Parallel.PArray.PRepr+import Data.Array.Parallel.PArray.Types+import Data.Array.Parallel.Lifted.TH.Repr+import Data.Array.Parallel.Lifted.Unboxed (elementsSegd#, elementsSel2_0#, elementsSel2_1#)+import Data.Array.Parallel.Base.DTrace (traceFn)+import Data.Array.Parallel.Base (intToTag)+import qualified Data.Array.Parallel.Unlifted as U+import Data.List (unzip4, unzip5)+import GHC.Exts (Int(..), Int#)+++-- Void -----------------------------------------------------------------------+-- | 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.+--+data instance PData Void++pvoid :: PData Void+pvoid = error "Data.Array.Parallel.PData Void"++$(voidPRInstance ''Void 'void 'pvoid)+++-- Unit -----------------------------------------------------------------------+-- | An array of unit values is represented by a single constructor.+-- There is only one possible value, so we only need to record it once.+--+-- We often uses arrays of unit values as the environmnent portion of a +-- lifted closure. For example, suppose we vectorise the unary function +-- @neg@. This function has no environment, so we construct the closure, +-- we fill in the environment field with @()@, which gives @Clo neg_v neg_l ()@.+--+-- Suppose we then compute @replicate n neg@. This results in an array of +-- closures. We only need one copy of the implementation functions neg_v and+-- neg_l, but the unit environment () is lifted to an array of units, +-- which we represent as PUnit.+--+-- Note that we need to store at least one real value, PUnit in this case, +-- because this value also represents the divergence behaviour of the whole+-- array. When evaluating a bulk-strict array, if any of the elements diverge +-- then the whole array does. We represent a diverging array of () by using+-- a diverging computation of type PUnit as its representation.+--+data instance PData ()+ = PUnit++punit :: PData ()+punit = PUnit++$(unitPRInstance 'PUnit)+++-- Wrap -----------------------------------------------------------------------+newtype instance PData (Wrap a)+ = PWrap (PData a)++$(wrapPRInstance ''Wrap 'Wrap 'unWrap 'PWrap)++{- Generated code:+instance PA a => PR (Wrap a) where+... INLINE pragmas ...+ emptyPR = traceFn "emptyPR" "Wrap a" (PWrap emptyPD)++ replicatePR n# (Wrap x)+ = traceFn "replicatePR" "Wrap a" (PWrap (replicatePD n# x))++ replicatelPR segd (PWrap xs)+ = traceFn "replicatelPR" "Wrap a" (PWrap (replicatelPD segd xs))++ repeatPR n# len# (PWrap xs)+ = traceFn "repeatPR" "Wrap a" (PWrap (repeatPD n# len# xs))++ indexPR (PWrap xs) i#+ = traceFn "indexPR" "Wrap a" (Wrap (indexPD xs i#))++ extractPR (PWrap xs) i# n#+ = traceFn "extractPR" "Wrap a" (PWrap (extractPD xs i# n#))++ bpermutePR (PWrap xs) n# is+ = traceFn "bpermutePR" "Wrap a" (PWrap (bpermutePD xs n# is))++ appPR (PWrap xs1) (PWrap xs2)+ = traceFn "appPR" "Wrap a" (PWrap (appPD xs1 xs2))++ applPR segd is (PWrap xs1) js (PWrap xs2)+ = traceFn "applPR" "Wrap a" (PWrap (applPD segd is xs1 js xs2))++ packByTagPR (PWrap xs) n# tags t#+ = traceFn+ "packByTagPR" "Wrap a" (PWrap (packByTagPD xs n# tags t#))++ combine2PR n# sel (PWrap xs1) (PWrap xs2)+ = traceFn "combine2PR" "Wrap a" (PWrap (combine2PD n# sel xs1 xs2))++ updatePR (PWrap xs1) is (PWrap xs2)+ = traceFn "updatePR" "Wrap a" (PWrap (updatePD xs1 is xs2))++ fromListPR n# xs+ = traceFn "fromListPR" "Wrap a" (PWrap (fromListPD n# (map unWrap xs)))+ + nfPR (PWrap xs) + = traceFn "nfPR" "Wrap a" (nfPD xs) }+-}+++-- Tuples ---------------------------------------------------------------------+$(tupleInstances [2..5])++{- Generated code:++data instance PData (a,b)+ = P_2 (PData a)+ (PData b)++instance (PR a, PR b) => PR (a,b) where+ {-# INLINE emptyPR #-}+ emptyPR = P_2 emptyPR emptyPR++ {-# INLINE replicatePR #-}+ replicatePR n# (a,b) = + P_2 (replicatePR n# a)+ (replicatePR n# b)++ {-# INLINE replicatelPR #-}+ replicatelPR segd (P_2 as bs) =+ P_2 (replicatelPR segd as)+ (replicatelPR segd bs) ++ {-# INLINE repeatPR #-}+ repeatPR n# len# (P_2 as bs) =+ P_2 (repeatPR n# len# as)+ (repeatPR n# len# bs)++ {-# INLINE indexPR #-}+ indexPR (P_2 as bs) i# = (indexPR as i#, indexPR bs i#)++ {-# INLINE extractPR #-}+ extractPR (P_2 as bs) i# n# = + P_2 (extractPR as i# n#)+ (extractPR bs i# n#)++ {-# INLINE bpermutePR #-}+ bpermutePR (P_2 as bs) n# is =+ P_2 (bpermutePR as n# is)+ (bpermutePR bs n# is)++ {-# INLINE appPR #-}+ appPR (P_2 as1 bs1) (P_2 as2 bs2) =+ P_2 (appPR as1 as2) (appPR bs1 bs2)++ {-# INLINE applPR #-}+ applPR is (P_2 as1 bs1) js (P_2 as2 bs2) =+ P_2 (applPR is as1 js as2)+ (applPR is bs1 js bs2)++ {-# INLINE packByTagPR #-}+ packByTagPR (P_2 as bs) n# tags t# =+ P_2 (packByTagPR as n# tags t#)+ (packByTagPR bs n# tags t#)++ {-# INLINE combine2PR #-}+ combine2PR n# sel (P_2 as1 bs1) (P_2 as2 bs2) =+ P_2 (combine2PR n# sel as1 as2)+ (combine2PR n# sel bs1 bs2)++ {-# INLINE updatePR #-}+ updatePR (P_2 as1 bs1) is (P_2 as2 bs2) =+ P_2 (updatePR as1 is as2)+ (updatePR bs1 is bs2)++ {-# INLINE fromListPR #-}+ fromListPR n# xs = let (as,bs) = unzip xs in+ P_2 (fromListPR n# as)+ (fromListPR n# bs)++ {-# INLINE nfPR #-}+ nfPR (P_2 as bs) = nfPR as `seq` nfPR bs+-}+++-- Operators on arrays of tuples.+-- These are here instead of in "Data.Array.Parallel.PArray.Base" because+-- they need to know about the P_2 P_3 constructors. These are the representations+-- of tuple constructors that are generated by $(tupleInstances) above.+zipPA# :: PArray a -> PArray b -> PArray (a ,b)+{-# INLINE_PA zipPA# #-}+zipPA# (PArray n# xs) (PArray _ ys)+ = PArray n# (P_2 xs ys)++unzipPA# :: PArray (a, b) -> (PArray a, PArray b)+{-# INLINE_PA unzipPA# #-}+unzipPA# (PArray n# (P_2 xs ys))+ = (PArray n# xs, PArray n# ys)+++zip3PA# :: PArray a -> PArray b -> PArray c -> PArray (a, b, c)+{-# INLINE_PA zip3PA# #-}+zip3PA# (PArray n# xs) (PArray _ ys) (PArray _ zs)+ = PArray n# (P_3 xs ys zs)+++-- Sums -----------------------------------------------------------------------+data instance PData (Sum2 a b)+ = PSum2 U.Sel2 (PData a) (PData b)+++instance (PR a, PR b) => PR (Sum2 a b) where + {-# INLINE emptyPR #-}+ emptyPR+ = traceFn "emptyPR" "(Sum2 a b)" $+ PSum2 (U.mkSel2 U.empty U.empty 0 0 (U.mkSelRep2 U.empty)) emptyPR emptyPR++ {-# INLINE replicatePR #-}+ replicatePR n# (Alt2_1 x)+ = traceFn "replicatePR" "(Sum2 a b)" $+ PSum2 (U.mkSel2 (U.replicate (I# n#) 0)+ (U.enumFromStepLen 0 1 (I# n#))+ (I# n#) 0+ (U.mkSelRep2 (U.replicate (I# n#) 0)))+ (replicatePR n# x)+ emptyPR+ replicatePR n# (Alt2_2 x)+ = traceFn "replicatePR" "(Sum2 a b)" $+ PSum2 (U.mkSel2 (U.replicate (I# n#) 1)+ (U.enumFromStepLen 0 1 (I# n#))+ 0 (I# n#)+ (U.mkSelRep2 (U.replicate (I# n#) 1)))+ emptyPR+ (replicatePR n# x)++ {-# INLINE replicatelPR #-}+ replicatelPR segd (PSum2 sel as bs)+ = traceFn "replicatelPR" "(Sum2 a b)" $+ PSum2 sel' as' bs'+ where+ tags = U.tagsSel2 sel+ tags' = U.replicate_s segd tags+ sel' = U.tagsToSel2 tags'++ lens = U.lengthsSegd segd++ asegd = U.lengthsToSegd (U.packByTag lens tags 0)+ bsegd = U.lengthsToSegd (U.packByTag lens tags 1)++ as' = replicatelPR asegd as+ bs' = replicatelPR bsegd bs++ {-# INLINE repeatPR #-}+ repeatPR m# n# (PSum2 sel as bs)+ = traceFn "repeatPR" "(Sum2 a b)" $+ PSum2 sel' as' bs'+ where+ sel' = U.tagsToSel2+ . U.repeat (I# m#) (I# n#)+ $ U.tagsSel2 sel++ as' = repeatPR m# (elementsSel2_0# sel) as+ bs' = repeatPR n# (elementsSel2_1# sel) bs++ {-# INLINE indexPR #-}+ indexPR (PSum2 sel as bs) i#+ = traceFn "indexPR" "(Sum2 a b)" $+ case U.indicesSel2 sel U.!: I# i# of+ I# k# -> case U.tagsSel2 sel U.!: I# i# of+ 0 -> Alt2_1 (indexPR as k#)+ _ -> Alt2_2 (indexPR bs k#)++ {-# INLINE appPR #-}+ appPR (PSum2 sel1 as1 bs1)+ (PSum2 sel2 as2 bs2)+ = traceFn "appPR" "(Sum2 a b)" $ + PSum2 sel (appPR as1 as2)+ (appPR bs1 bs2)+ where+ sel = U.tagsToSel2+ $ U.tagsSel2 sel1 U.+:+ U.tagsSel2 sel2++ {-# INLINE packByTagPR #-}+ packByTagPR (PSum2 sel as bs) _ tags t#+ = PSum2 sel' as' bs'+ where+ my_tags = U.tagsSel2 sel+ my_tags' = U.packByTag my_tags tags (intToTag (I# t#))+ sel' = U.tagsToSel2 my_tags'++ atags = U.packByTag tags my_tags 0+ btags = U.packByTag tags my_tags 1++ as' = packByTagPR as (elementsSel2_0# sel') atags t#+ bs' = packByTagPR bs (elementsSel2_1# sel') btags t#++ {-# INLINE combine2PR #-}+ combine2PR _ sel (PSum2 sel1 as1 bs1)+ (PSum2 sel2 as2 bs2)+ = traceFn "combine2PR" "(Sum2 a b)" $+ PSum2 sel' as bs+ where+ tags = U.tagsSel2 sel+ tags' = U.combine2 (U.tagsSel2 sel) (U.repSel2 sel)+ (U.tagsSel2 sel1)+ (U.tagsSel2 sel2)+ sel' = U.tagsToSel2 tags'++ asel = U.tagsToSel2 (U.packByTag tags tags' 0)+ bsel = U.tagsToSel2 (U.packByTag tags tags' 1)++ as = combine2PR (elementsSel2_0# sel') asel as1 as2+ bs = combine2PR (elementsSel2_1# sel') bsel bs1 bs2+++-- Nested Arrays --------------------------------------------------------------+data instance PData (PArray a)+ = PNested U.Segd (PData a)++instance PR a => PR (PArray a) where+ {-# INLINE emptyPR #-}+ emptyPR = traceFn "emptyPR" "(PArray a)" $+ PNested (U.mkSegd U.empty U.empty 0) emptyPR++ {-# INLINE replicatePR #-}+ replicatePR n# (PArray m# xs)+ = traceFn "replicatePR" "(PArray a)" $+ PNested (U.mkSegd (U.replicate (I# n#) (I# m#))+ (U.enumFromStepLen 0 (I# m#) (I# n#))+ (I# n# * I# m#))+ (repeatPR n# m# xs)++ {-# INLINE indexPR #-}+ indexPR (PNested segd xs) i#+ = traceFn "indexPR" "(PArray a)" $+ case U.lengthsSegd segd U.!: I# i# of { I# n# ->+ case U.indicesSegd segd U.!: I# i# of { I# k# ->+ PArray n# (extractPR xs k# n#) }}++ {-# INLINE extractPR #-}+ extractPR (PNested segd xs) i# n#+ = traceFn "extractPR" "(PArray a)" $+ PNested segd' (extractPR xs k# (elementsSegd# segd'))+ where+ segd' = U.lengthsToSegd+ $ U.extract (U.lengthsSegd segd) (I# i#) (I# n#)++ -- NB: not indicesSegd segd !: i because i might be one past the end+ !(I# k#) | I# i# == 0 = 0+ | otherwise = U.indicesSegd segd U.!: (I# i# - 1)+ + U.lengthsSegd segd U.!: (I# i# - 1)++ {-# INLINE bpermutePR #-}+ bpermutePR (PNested segd xs) _ is+ = traceFn "bpermutePR" "(PArray a)" $+ PNested segd' (bpermutePR xs (elementsSegd# segd') js)+ where+ lens' = U.bpermute (U.lengthsSegd segd) is+ starts = U.bpermute (U.indicesSegd segd) is++ segd' = U.lengthsToSegd lens'++ js = U.zipWith (+) (U.indices_s segd')+ (U.replicate_s segd' starts)++ {-# INLINE appPR #-}+ appPR (PNested xsegd xs) (PNested ysegd ys)+ = traceFn "appPR" "(PArray a)" $ + PNested (U.lengthsToSegd (U.lengthsSegd xsegd U.+:+ U.lengthsSegd ysegd))+ (appPR xs ys)++ {-# INLINE applPR #-}+ applPR rsegd segd1 (PNested xsegd xs) segd2 (PNested ysegd ys)+ = traceFn "applPR" "(PArray a)"$+ PNested segd (applPR (U.plusSegd xsegd' ysegd') xsegd' xs ysegd' ys)+ where+ segd = U.lengthsToSegd+ $ U.append_s rsegd segd1 (U.lengthsSegd xsegd)+ segd2 (U.lengthsSegd ysegd)++ xsegd' = U.lengthsToSegd+ $ U.sum_s segd1 (U.lengthsSegd xsegd)+ ysegd' = U.lengthsToSegd+ $ U.sum_s segd2 (U.lengthsSegd ysegd)++ {-# INLINE repeatPR #-}+ repeatPR n# len# (PNested segd xs)+ = traceFn "repeatPR" "(PArray a)" $+ PNested segd' (repeatPR n# (elementsSegd# segd) xs)+ where+ segd' = U.lengthsToSegd (U.repeat (I# n#) (I# len#) (U.lengthsSegd segd))++ {-# INLINE replicatelPR #-}+ replicatelPR segd (PNested xsegd xs)+ = traceFn "replicatelPR" "(PArray a)" $+ PNested xsegd' $ bpermutePR xs (elementsSegd# xsegd')+ $ U.enumFromStepLenEach (U.elementsSegd xsegd')+ is (U.replicate (U.elementsSegd segd) 1) ns+ where+ is = U.replicate_s segd (U.indicesSegd xsegd)+ ns = U.replicate_s segd (U.lengthsSegd xsegd)+ xsegd' = U.lengthsToSegd ns++ {-# INLINE packByTagPR #-}+ packByTagPR (PNested segd xs) _ tags t#+ = traceFn "packByTagPR" "(PArray a)" $+ PNested segd' xs'+ where+ segd' = U.lengthsToSegd+ $ U.packByTag (U.lengthsSegd segd) tags (intToTag (I# t#))++ xs' = packByTagPR xs (elementsSegd# segd') (U.replicate_s segd tags) t#++ {-# INLINE combine2PR #-}+ combine2PR _ sel (PNested xsegd xs) (PNested ysegd ys)+ = traceFn "combine2PR" "(PArray a)" $+ PNested segd xys+ where+ tags = U.tagsSel2 sel++ segd = U.lengthsToSegd+ $ U.combine2 (U.tagsSel2 sel) (U.repSel2 sel)+ (U.lengthsSegd xsegd)+ (U.lengthsSegd ysegd)++ sel' = U.tagsToSel2+ $ U.replicate_s segd tags++ xys = combine2PR (elementsSegd# segd) sel' xs ys+++-- Operators on Nested Arrays+-- These are here instead of in "Data.Array.Parallel.PArray.Base" because+-- they need to know about the PNested constructor which is defined above.++-- | O(1). Extract the segment descriptor from a nested array.+segdPA# :: PArray (PArray a) -> U.Segd+{-# INLINE_PA segdPA# #-}+segdPA# (PArray _ (PNested segd _))+ = segd+++-- | O(1). Concatenate a nested array. This is a constant time operation as+-- we can just discard the segment descriptor.+concatPA# :: PArray (PArray a) -> PArray a+{-# INLINE_PA concatPA# #-}+concatPA# (PArray _ (PNested segd xs))+ = PArray (elementsSegd# segd) xs+++-- | O(1). Create a nested array from an element count, segment descriptor,+-- and data elements.+segmentPA# :: Int# -> U.Segd -> PArray a -> PArray (PArray a)+{-# INLINE_PA segmentPA# #-}+segmentPA# n# segd (PArray _ xs)+ = PArray n# (PNested segd xs)+++-- | O(1). Create a nested array by using the element count and segment+-- descriptor from another, but use new data elements.+copySegdPA# :: PArray (PArray a) -> PArray b -> PArray (PArray b)+{-# INLINE copySegdPA# #-}+copySegdPA# (PArray n# (PNested segd _)) (PArray _ xs)+ = PArray n# (PNested segd xs)
+ Data/Array/Parallel/PArray/PRepr.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE CPP, FlexibleContexts #-}++#include "fusion-phases.h"++-- | Defines the family of types that can be represented generically,+-- and the functions to convert two and from the generic representation.+-- +-- TODO: Check inconsistent use of INLINE pragmas.+-- Most have INLINE_PA, but bpermutePD and nfPD have plain INLINE+--+module Data.Array.Parallel.PArray.PRepr (+ PRepr,+ PA(..),+ + -- These functions have corresponding members in the PR class+ -- from Data.Array.Parallel.PArray.PData.+ emptyPD,+ replicatePD,+ replicatelPD,+ repeatPD,+ indexPD,+ extractPD,+ bpermutePD,+ appPD,+ applPD,+ packByTagPD,+ combine2PD,+ updatePD,+ fromListPD,+ nfPD+)+where+import Data.Array.Parallel.PArray.PData+++-- | Representable types.+--+-- The family of types that we know how to represent generically.+-- PRepr takes an arbitrary type and produces the generic type we use to +-- represent it.+--+-- Instances for simple types are defined in Data.Array.Parallel.Lifted.Instances.+-- For algebraic types, it's up to the vectoriser/client module to create+-- a suitable instance.+--+type family PRepr a+++-- | A PA dictionary contains the functions that we use to convert a+-- representable type to and from its generic representation.+-- The conversion methods should all be O(1).+--+class PR (PRepr a) => PA a where+ toPRepr :: a -> PRepr a+ fromPRepr :: PRepr a -> a+ toArrPRepr :: PData a -> PData (PRepr a)+ fromArrPRepr :: PData (PRepr a) -> PData a+++-- PD Wrappers ----------------------------------------------------------------+-- These wrappers work on (PData a) arrays when we know the element type 'a'+-- is representable. For most of them we can just convert the PData to the +-- underlying representation type, and use the corresponding operator from+-- the PR dictionary.+--+emptyPD :: PA a => T_emptyPR a+{-# INLINE_PA emptyPD #-}+emptyPD + = fromArrPRepr emptyPR++replicatePD :: PA a => T_replicatePR a+{-# INLINE_PA replicatePD #-}+replicatePD n# x + = fromArrPRepr+ . replicatePR n#+ $ toPRepr x++replicatelPD :: PA a => T_replicatelPR a+{-# INLINE_PA replicatelPD #-}+replicatelPD segd xs + = fromArrPRepr+ . replicatelPR segd+ $ toArrPRepr xs+ +repeatPD :: PA a => T_repeatPR a+{-# INLINE_PA repeatPD #-}+repeatPD n# len# xs + = fromArrPRepr+ . repeatPR n# len#+ $ toArrPRepr xs++indexPD :: PA a => T_indexPR a+{-# INLINE_PA indexPD #-}+indexPD xs i# + = fromPRepr + $ indexPR (toArrPRepr xs) i#++extractPD :: PA a => T_extractPR a+{-# INLINE_PA extractPD #-}+extractPD xs i# m#+ = fromArrPRepr + $ extractPR (toArrPRepr xs) i# m#++bpermutePD :: PA a => T_bpermutePR a+{-# INLINE bpermutePD #-}+bpermutePD xs n# is + = fromArrPRepr + $ bpermutePR (toArrPRepr xs) n# is++appPD :: PA a => T_appPR a+{-# INLINE_PA appPD #-}+appPD xs ys + = fromArrPRepr + $ appPR (toArrPRepr xs) (toArrPRepr ys)++applPD :: PA a => T_applPR a+{-# INLINE_PA applPD #-}+applPD segd is xs js ys+ = fromArrPRepr + $ applPR segd is (toArrPRepr xs) js (toArrPRepr ys)++packByTagPD :: PA a => T_packByTagPR a+{-# INLINE_PA packByTagPD #-}+packByTagPD xs n# tags t#+ = fromArrPRepr + $ packByTagPR (toArrPRepr xs) n# tags t#++combine2PD :: PA a => T_combine2PR a+{-# INLINE_PA combine2PD #-}+combine2PD n# sel as bs+ = fromArrPRepr + $ combine2PR n# sel (toArrPRepr as) (toArrPRepr bs)++updatePD :: PA a => T_updatePR a+{-# INLINE_PA updatePD #-}+updatePD xs is ys+ = fromArrPRepr+ $ updatePR (toArrPRepr xs) is (toArrPRepr ys)++fromListPD :: PA a => T_fromListPR a+{-# INLINE_PA fromListPD #-}+fromListPD n# xs + = fromArrPRepr+ $ fromListPR n# (map toPRepr xs)++nfPD :: PA a => T_nfPR a+{-# INLINE nfPD #-}+nfPD xs = nfPR (toArrPRepr xs)++
+ Data/Array/Parallel/PArray/PReprInstances.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -fno-warn-orphans #-}++#include "fusion-phases.h"++-- | Instances for the PRepr class.+--+-- For primitive types these are all trivial, as we represent an array of+-- Ints just as an array of Ints. +--+-- For algebraic data types defined in the source program, the vectoriser+-- creates the appropriate PRepr instances for those types.+--+-- Note that polymorphic container types like tuples and arrays use the +-- `Wrap` constructor so we only need to convert one layer of the structure+-- to the generic representation at a time. +-- See "Data.Array.Parallel.PArray.Types" for details.+--+module Data.Array.Parallel.PArray.PReprInstances where+import Data.Array.Parallel.PArray.PRepr+import Data.Array.Parallel.PArray.PData+import Data.Array.Parallel.PArray.PDataInstances+import Data.Array.Parallel.PArray.Base+import Data.Array.Parallel.PArray.ScalarInstances ()+import Data.Array.Parallel.PArray.Types+import qualified Data.Array.Parallel.Unlifted as U+import GHC.Word ( Word8 )+++-- Void -----------------------------------------------------------------------+type instance PRepr Void = Void++instance PA Void where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id+++-- Unit -----------------------------------------------------------------------+type instance PRepr () = ()++instance PA () where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id+++-- Int ------------------------------------------------------------------------+type instance PRepr Int = Int++instance PA Int where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id++++-- Word8 ----------------------------------------------------------------------+type instance PRepr Word8 = Word8++instance PA Word8 where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id+++-- Float ----------------------------------------------------------------------+type instance PRepr Float = Float++instance PA Float where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id+++-- Double ---------------------------------------------------------------------+type instance PRepr Double = Double++instance PA Double where+ toPRepr = id+ fromPRepr = id+ toArrPRepr = id+ fromArrPRepr = id+++-- Bool -----------------------------------------------------------------------+data instance PData Bool+ = PBool U.Sel2++type instance PRepr Bool = Sum2 Void Void++instance PA Bool where+ {-# INLINE toPRepr #-}+ toPRepr False = Alt2_1 void+ toPRepr True = Alt2_2 void++ {-# INLINE fromPRepr #-}+ fromPRepr (Alt2_1 _) = False+ fromPRepr (Alt2_2 _) = True++ {-# INLINE toArrPRepr #-}+ toArrPRepr (PBool sel) = PSum2 sel pvoid pvoid++ {-# INLINE fromArrPRepr #-}+ fromArrPRepr (PSum2 sel _ _) = PBool sel+++-- Tuple2 ---------------------------------------------------------------------+type instance PRepr (a,b)+ = (Wrap a, Wrap b)++instance (PA a, PA b) => PA (a,b) where+ toPRepr (a, b)+ = (Wrap a, Wrap b)++ fromPRepr (Wrap a, Wrap b)+ = (a, b)++ toArrPRepr (P_2 as bs)+ = P_2 (PWrap as) (PWrap bs)++ fromArrPRepr (P_2 (PWrap as) (PWrap bs))+ = P_2 as bs+++-- Tuple3 ---------------------------------------------------------------------+type instance PRepr (a,b,c) + = (Wrap a, Wrap b, Wrap c)++instance (PA a, PA b, PA c) => PA (a,b,c) where+ toPRepr (a, b, c) + = (Wrap a, Wrap b, Wrap c)++ fromPRepr (Wrap a, Wrap b, Wrap c)+ = (a, b, c)++ toArrPRepr (P_3 as bs cs)+ = P_3 (PWrap as) (PWrap bs) (PWrap cs)++ fromArrPRepr (P_3 (PWrap as) (PWrap bs) (PWrap cs))+ = P_3 as bs cs+++-- Tuple4 ---------------------------------------------------------------------+type instance PRepr (a,b,c,d)+ = (Wrap a, Wrap b, Wrap c, Wrap d)++instance (PA a, PA b, PA c, PA d) => PA (a,b,c,d) where+ toPRepr (a, b, c, d)+ = (Wrap a, Wrap b, Wrap c, Wrap d)++ fromPRepr (Wrap a, Wrap b, Wrap c, Wrap d)+ = (a, b, c, d)++ toArrPRepr (P_4 as bs cs ds)+ = P_4 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds)++ fromArrPRepr (P_4 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds))+ = P_4 as bs cs ds+++-- Tuple5 ---------------------------------------------------------------------+type instance PRepr (a,b,c,d,e)+ = (Wrap a, Wrap b, Wrap c, Wrap d, Wrap e)++instance (PA a, PA b, PA c, PA d, PA e) => PA (a,b,c,d,e) where+ toPRepr (a, b, c, d, e)+ = (Wrap a, Wrap b, Wrap c, Wrap d, Wrap e)++ fromPRepr (Wrap a, Wrap b, Wrap c, Wrap d, Wrap e)+ = (a, b, c, d, e)++ toArrPRepr (P_5 as bs cs ds es)+ = P_5 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds) (PWrap es) ++ fromArrPRepr (P_5 (PWrap as) (PWrap bs) (PWrap cs) (PWrap ds) (PWrap es))+ = P_5 as bs cs ds es+++-- PArray ---------------------------------------------------------------------+type instance PRepr (PArray a)+ = PArray (PRepr a)++instance PA a => PA (PArray a) where+ {-# INLINE toPRepr #-}+ toPRepr (PArray n# xs) + = PArray n# (toArrPRepr xs)++ {-# INLINE fromPRepr #-}+ fromPRepr (PArray n# xs)+ = PArray n# (fromArrPRepr xs)++ {-# INLINE toArrPRepr #-}+ toArrPRepr (PNested segd xs)+ = PNested segd (toArrPRepr xs)++ {-# INLINE fromArrPRepr #-}+ fromArrPRepr (PNested segd xs)+ = PNested segd (fromArrPRepr xs)+
+ Data/Array/Parallel/PArray/Scalar.hs view
@@ -0,0 +1,148 @@+{-# OPTIONS -fno-warn-orphans #-}+-- | Defines the class of scalar element types, as well as the +-- PData instances for these types.+--+module Data.Array.Parallel.PArray.Scalar (+ Scalar(..),++ -- These functions have corresponding members in the PR class+ -- from Data.Array.Parallel.PArray.PData.+ emptyPRScalar,+ replicatePRScalar,+ replicatelPRScalar,+ repeatPRScalar, + indexPRScalar,+ extractPRScalar,+ bpermutePRScalar,+ appPRScalar,+ applPRScalar,+ packByTagPRScalar,+ combine2PRScalar,+ updatePRScalar,+ fromListPRScalar,+ nfPRScalar+)+where+import Data.Array.Parallel.PArray.PData+import Data.Array.Parallel.Base (intToTag, traceF )+import qualified Data.Array.Parallel.Unlifted as U+import GHC.Exts (Int(..))+++-- | Class of scalar types.+-- Scalar types are the ones that we can store in our underlying U.Arrays+-- (which are currently implemented as Data.Vectors).+--+-- To perform an operation on a PData array of scalar elements, we coerce+-- it to the underling U.Array and use the corresponding U.Array operators.+--+class U.Elt a => Scalar a where+ fromScalarPData :: PData a -> U.Array a+ toScalarPData :: U.Array a -> PData a+++-- Scalar Wrappers ------------------------------------------------------------+-- These wrappers work on (PData a) arrays when we know the element type 'a'+-- is scalar. For most of them we can just coerce the PData to the underling +-- U.Array and use the corresponding U.Array operator.+--+-- The underlying U.Array may be processed in parallel or sequentially,+-- depending on what U.Array primitive library has been linked in.+--+emptyPRScalar :: Scalar a => T_emptyPR a+{-# INLINE emptyPRScalar #-}+emptyPRScalar + = toScalarPData U.empty++replicatePRScalar :: Scalar a => T_replicatePR a+{-# INLINE replicatePRScalar #-}+replicatePRScalar n# x+ = traceF "replicatePRScalar"+ $ toScalarPData (U.replicate (I# n#) x)++replicatelPRScalar :: Scalar a => T_replicatelPR a+{-# INLINE replicatelPRScalar #-}+replicatelPRScalar segd xs + = traceF "replicatelPRScalar"+ $ toScalarPData+ $ U.replicate_s segd + $ fromScalarPData xs++repeatPRScalar :: Scalar a => T_repeatPR a+{-# INLINE repeatPRScalar #-}+repeatPRScalar n# len# xs+ = traceF "repeatPRScalar"+ $ toScalarPData+ $ U.repeat (I# n#) (I# len#)+ $ fromScalarPData xs++indexPRScalar :: Scalar a => T_indexPR a+{-# INLINE indexPRScalar #-}+indexPRScalar xs i#+ = fromScalarPData xs U.!: I# i#++extractPRScalar :: Scalar a => T_extractPR a+{-# INLINE extractPRScalar #-}+extractPRScalar xs i# n#+ = traceF "extractPRScalar"+ $ toScalarPData+ $ U.extract (fromScalarPData xs) (I# i#) (I# n#)++bpermutePRScalar :: Scalar a => T_bpermutePR a+{-# INLINE bpermutePRScalar #-}+bpermutePRScalar xs _ is+ = traceF "bpermutePRScalar"+ $ toScalarPData+ $ U.bpermute (fromScalarPData xs) is++appPRScalar :: Scalar a => T_appPR a+{-# INLINE appPRScalar #-}+appPRScalar xs ys+ = traceF "appPRScalar"+ $ toScalarPData+ $ fromScalarPData xs U.+:+ fromScalarPData ys++applPRScalar :: Scalar a => T_applPR a+{-# INLINE applPRScalar #-}+applPRScalar segd xsegd xs ysegd ys+ = traceF "applPRScalar"+ $ toScalarPData+ $ U.append_s segd xsegd (fromScalarPData xs)+ ysegd (fromScalarPData ys)+ +packByTagPRScalar :: Scalar a => T_packByTagPR a+{-# INLINE packByTagPRScalar #-}+packByTagPRScalar xs _ tags t#+ = traceF "packByTagPRScalar"+ $ toScalarPData+ $ U.packByTag (fromScalarPData xs)+ tags+ (intToTag (I# t#))++combine2PRScalar :: Scalar a => T_combine2PR a+{-# INLINE combine2PRScalar #-}+combine2PRScalar _ sel xs ys + = traceF "combine2PRScalar"+ $ toScalarPData+ $ U.combine2 (U.tagsSel2 sel)+ (U.repSel2 sel)+ (fromScalarPData xs)+ (fromScalarPData ys)++updatePRScalar :: Scalar a => T_updatePR a+{-# INLINE updatePRScalar #-}+updatePRScalar xs is ys + = traceF "updatePRScalar"+ $ toScalarPData+ $ U.update (fromScalarPData xs)+ (U.zip is (fromScalarPData ys))++fromListPRScalar :: Scalar a => T_fromListPR a+{-# INLINE fromListPRScalar #-}+fromListPRScalar _ xs+ = toScalarPData (U.fromList xs)++nfPRScalar :: Scalar a => T_nfPR a+{-# INLINE nfPRScalar #-}+nfPRScalar xs+ = fromScalarPData xs `seq` ()
+ Data/Array/Parallel/PArray/ScalarInstances.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+#include "fusion-phases.h"++-- | Instances for the Scalar class.+-- These let us coerce scalar U.Arrays to PData arrays.+module Data.Array.Parallel.PArray.ScalarInstances where+import Data.Array.Parallel.Lifted.TH.Repr+import Data.Array.Parallel.PArray.Scalar +import Data.Array.Parallel.PArray.PData+import GHC.Word ( Word8 )+++$(scalarInstances [''Int, ''Float, ''Double, ''Word8])++{- Generated code:+ newtype instance PData Int = PInt (U.Array Int)++ instance Scalar Int where+ fromScalarPData (PInt xs) = xs+ toScalarPData = PInt++ instance PR Int where+ <forward to *PRScalar methods>+-}
+ Data/Array/Parallel/PArray/Types.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE EmptyDataDecls #-}++-- | Defines the extra types we use when representing algebraic data in parallel arrays.+-- We don't store values of user defined algebraic type directly in PArrays. Instead,+-- we convert these to a generic representation and store that representation.+--+-- Conversion to and from the generic representation is handled by the methods+-- of the PA class defined in "Data.Array.Parallel.PArray.PRepr".+--+--- For further information see:+-- "Instant Generics: Fast and Easy", Chakravarty, Ditu and Keller, 2009+-- +module Data.Array.Parallel.PArray.Types (+ -- * The Void type+ Void,+ void,+ fromVoid, ++ -- * Generic sums+ Sum2(..),+ Sum3(..),++ -- * The Wrap type+ Wrap (..)+)+where++-- Void -----------------------------------------------------------------------+-- | 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.+data Void++-- | A 'value' with the void type. Used as a placholder like `undefined`.+-- Forcing this yields `error`. +void :: Void+void = error $ unlines+ [ "Data.Array.Parallel.PArray.Types.void"+ , " With the DPH generic array representation, values of type void"+ , " should never be forced. Something has gone badly wrong." ]+++-- | Coerce a `Void` to a different type. Used as a placeholder like `undefined`.+-- Forcing the result yields `error`.+fromVoid :: a+fromVoid = error $unlines+ [ "Data.Array.Parallel.PArray.Types.fromVoid"+ , " With the DPH generic array representation, values of type void"+ , " should never be forced. Something has gone badly wrong." ]+++-- Sums -----------------------------------------------------------------------+-- | Sum types used for the generic representation of algebraic data.+data Sum2 a b = Alt2_1 a | Alt2_2 b+data Sum3 a b c = Alt3_1 a | Alt3_2 b | Alt3_3 c+++-- Wrap -----------------------------------------------------------------------+-- | When converting a data type to its generic representation, we use+-- `Wrap` to help us convert only one layer at a time. For example:+--+-- @+-- data Foo a = Foo Int a+--+-- instance PA a => PA (Foo a) where+-- type PRepr (Foo a) = (Int, Wrap a) -- define how (Foo a) is represented+-- @+--+-- Here we've converted the @Foo@ data constructor to a pair, and Int+-- is its own representation type. We have PData/PR instances for pairs and+-- Ints, so we can work with arrays of these types. However, we can't just+-- use (Int, a) as the representation of (Foo a) because 'a' might+-- be user defined and we won't have PData/PR instances for it.+--+-- Instead, we wrap the second element with the Wrap constructor, which tells+-- us that if we want to process this element we still need to convert it+-- to the generic representation (and back). This last part is done by+-- the PR instance of Wrap, who's methods are defined by calls to the *PD +-- functions from "Data.Array.Parallel.PArray.PRepr".+--+newtype Wrap a = Wrap { unWrap :: a }+++
+ Data/Array/Parallel/Prelude.hs view
@@ -0,0 +1,22 @@+-- | This module (as well as the type-specific modules 'Data.Array.Parallel.Prelude.*') are a+-- temporary kludge needed as DPH programs cannot directly use the (non-vectorised) functions from+-- the standard Prelude. It also exports some conversion helpers.+--+-- /This module should not be explicitly imported in user code anymore./ User code should only+-- import 'Data.Array.Parallel' and, until the vectoriser supports type classes, the type-specific+-- modules 'Data.Array.Parallel.Prelude.*'.++module Data.Array.Parallel.Prelude (+ module Data.Array.Parallel.Prelude.Bool,+ module Data.Array.Parallel.Prelude.Tuple,++ PArray, Scalar(..), + toUArrPA, + fromUArrPA', fromUArrPA_2', fromUArrPA_3, fromUArrPA_3',+ nestUSegdPA'+) where++import Data.Array.Parallel.Prelude.Bool+import Data.Array.Parallel.Prelude.Tuple+import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.Lifted.Scalar
+ Data/Array/Parallel/Prelude/Bool.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ParallelArrays #-}+{-# OPTIONS_GHC -fvectorise #-}+ -- NB: Cannot use any parallel array syntax except the type constructor++module Data.Array.Parallel.Prelude.Bool (+ Bool(..),++ otherwise, (&&), (||), not, andP, orP,+ + -- FIXME: the Simplifier drops these bindings *after* vectorisation if not exported (although,+ -- they are referenced in the code generated by the vectoriser)+ and_l, or_l, not_l+) where++import Data.Array.Parallel.VectDepend () -- see Note [Vectoriser dependencies] in the same module++import Data.Array.Parallel.PArr ()+import Data.Array.Parallel.Lifted.Closure+import Data.Array.Parallel.PArray.PReprInstances+import Data.Array.Parallel.Lifted.Scalar+import qualified Data.Array.Parallel.Unlifted as U++import qualified Prelude as P+import Prelude (Bool(..), otherwise)+ -- NB: re-export 'Prelude.otherwise' instead of rolling a new one as the former is special-cased+ -- in the Desugarer++import Data.Bits++infixr 3 &&+infixr 2 ||++(&&) :: Bool -> Bool -> Bool+(&&) = (P.&&)+{-# VECTORISE (&&) = closure2 (P.&&) and_l #-}++and_l :: PArray Bool -> PArray Bool -> PArray Bool+{-# INLINE and_l #-}+and_l (PArray n# bs) (PArray _ cs)+ = PArray n# P.$+ case bs of { PBool sel1 ->+ case cs of { PBool sel2 ->+ PBool P.$ U.tagsToSel2 (U.zipWith (.&.) (U.tagsSel2 sel1) (U.tagsSel2 sel2)) }}+{-# NOVECTORISE and_l #-}++(||) :: Bool -> Bool -> Bool+(||) = (P.||)+{-# VECTORISE (||) = closure2 (P.||) or_l #-}++or_l :: PArray Bool -> PArray Bool -> PArray Bool+{-# INLINE or_l #-}+or_l (PArray n# bs) (PArray _ cs)+ = PArray n# P.$+ case bs of { PBool sel1 ->+ case cs of { PBool sel2 ->+ PBool P.$ U.tagsToSel2 (U.zipWith (.|.) (U.tagsSel2 sel1) (U.tagsSel2 sel2)) }}+{-# NOVECTORISE or_l #-}++not :: Bool -> Bool+not = P.not+{-# VECTORISE not = closure1 P.not not_l #-}++not_l :: PArray Bool -> PArray Bool+{-# INLINE not_l #-}+not_l (PArray n# bs)+ = PArray n# P.$+ case bs of { PBool sel ->+ PBool P.$ U.tagsToSel2 (U.map complement (U.tagsSel2 sel)) }+{-# NOVECTORISE not_l #-}++andP:: [:Bool:] -> Bool+{-# NOINLINE andP #-}+andP _ = True+{-# VECTORISE andP = closure1 (scalar_fold (&&) True) (scalar_folds (&&) True) #-}++orP:: [:Bool:] -> Bool+{-# NOINLINE orP #-}+orP _ = True+{-# VECTORISE orP = closure1 (scalar_fold (||) False) (scalar_folds (||) False) #-}
+ Data/Array/Parallel/Prelude/Double.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE ParallelArrays #-}+{-# OPTIONS_GHC -fvectorise #-}+ -- NB: Cannot use any parallel array syntax except the type constructor++module Data.Array.Parallel.Prelude.Double (+ Double,+ + -- Ord+ (==), (/=), (<), (<=), (>), (>=), min, max,++ minimumP, maximumP, minIndexP, maxIndexP,++ -- Num+ (+), (-), (*), negate, abs,++ sumP, productP,++ -- Fractional+ (/), recip,++ -- Floating+ pi, exp, sqrt, log, (**), logBase,+ sin, tan, cos, asin, atan, acos,+ sinh, tanh, cosh, asinh, atanh, acosh,++ -- RealFrac and similar+ fromInt,++ truncate, round, ceiling, floor,+) where++import Data.Array.Parallel.VectDepend () -- see Note [Vectoriser dependencies] in the same module++import Data.Array.Parallel.PArr+import Data.Array.Parallel.Lifted.Scalar+import Data.Array.Parallel.Lifted.Closure++import Prelude (Double, Int, Bool)+import qualified Prelude as P++infixr 8 **+infixl 7 *, /+infixl 6 +, -+infix 4 ==, /=, <, <=, >, >=++(==), (/=), (<), (<=), (>), (>=) :: Double -> Double -> Bool+(==) = (P.==)+{-# VECTORISE SCALAR (==) #-}+(/=) = (P./=)+{-# VECTORISE SCALAR (/=) #-}+(<=) = (P.<=)+{-# VECTORISE SCALAR (<=) #-}+(<) = (P.<)+{-# VECTORISE SCALAR (<) #-}+(>=) = (P.>=)+{-# VECTORISE SCALAR (>=) #-}+(>) = (P.>)+{-# VECTORISE SCALAR (>) #-}++min, max :: Double -> Double -> Double+min = P.min+{-# VECTORISE SCALAR min #-}+max = P.max+{-# VECTORISE SCALAR max #-}++minimumP, maximumP :: [:Double:] -> Double+{-# NOINLINE minimumP #-}+minimumP a = a `indexPArr` 0+{-# VECTORISE minimumP+ = closure1 (scalar_fold1 P.min) (scalar_fold1s P.min) :: PArray Double :-> Double #-}+{-# NOINLINE maximumP #-}+maximumP a = a `indexPArr` 0+{-# VECTORISE maximumP+ = closure1 (scalar_fold1 P.max) (scalar_fold1s P.max) :: PArray Double :-> Double #-}++minIndexP :: [:Double:] -> Int+{-# NOINLINE minIndexP #-}+minIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE minIndexP = minIndexPA #-}++minIndexPA :: PArray Double :-> Int+{-# INLINE minIndexPA #-}+minIndexPA = closure1 (scalar_fold1Index min') (scalar_fold1sIndex min')+{-# NOVECTORISE minIndexPA #-}++min' (i,x) (j,y) | x P.<= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE min' #-}++maxIndexP :: [:Double:] -> Int+{-# NOINLINE maxIndexP #-}+maxIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE maxIndexP = maxIndexPA #-}++maxIndexPA :: PArray Double :-> Int+{-# INLINE maxIndexPA #-}+maxIndexPA = closure1 (scalar_fold1Index max') (scalar_fold1sIndex max')+{-# NOVECTORISE maxIndexPA #-}++max' (i,x) (j,y) | x P.>= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE max' #-}++(+), (-), (*) :: Double -> Double -> Double+(+) = (P.+)+{-# VECTORISE SCALAR (+) #-}+(-) = (P.-)+{-# VECTORISE SCALAR (-) #-}+(*) = (P.*)+{-# VECTORISE SCALAR (*) #-}++negate, abs :: Double -> Double+negate = P.negate+{-# VECTORISE SCALAR negate #-}+abs = P.abs+{-# VECTORISE SCALAR abs #-}++sumP, productP :: [:Double:] -> Double+{-# NOINLINE sumP #-}+sumP a = a `indexPArr` 0+{-# VECTORISE sumP + = closure1 (scalar_fold (+) 0) (scalar_folds (+) 0) :: PArray Double :-> Double #-}+{-# NOINLINE productP #-}+productP a = a `indexPArr` 0+{-# VECTORISE productP + = closure1 (scalar_fold (*) 1) (scalar_folds (*) 1) :: PArray Double :-> Double #-}++(/) :: Double -> Double -> Double+(/) = (P./)+{-# VECTORISE SCALAR (/) #-}++recip :: Double -> Double+recip = P.recip+{-# VECTORISE SCALAR recip #-}++pi :: Double+pi = P.pi+{-# NOVECTORISE pi #-}++exp, sqrt, log, sin, tan, cos, asin, atan, acos, sinh, tanh, cosh,+ asinh, atanh, acosh :: Double -> Double+exp = P.exp+{-# VECTORISE SCALAR exp #-}+sqrt = P.sqrt+{-# VECTORISE SCALAR sqrt #-}+log = P.log+{-# VECTORISE SCALAR log #-}+sin = P.sin+{-# VECTORISE SCALAR sin #-}+tan = P.tan+{-# VECTORISE SCALAR tan #-}+cos = P.cos+{-# VECTORISE SCALAR cos #-}+asin = P.asin+{-# VECTORISE SCALAR asin #-}+atan = P.atan+{-# VECTORISE SCALAR atan #-}+acos = P.acos+{-# VECTORISE SCALAR acos #-}+sinh = P.sinh+{-# VECTORISE SCALAR sinh #-}+tanh = P.tanh+{-# VECTORISE SCALAR tanh #-}+cosh = P.cosh+{-# VECTORISE SCALAR cosh #-}+asinh = P.asinh+{-# VECTORISE SCALAR asinh #-}+atanh = P.atanh+{-# VECTORISE SCALAR atanh #-}+acosh = P.acosh+{-# VECTORISE SCALAR acosh #-}++(**), logBase :: Double -> Double -> Double+(**) = (P.**)+{-# VECTORISE SCALAR (**) #-}+logBase = P.logBase+{-# VECTORISE SCALAR logBase #-}++fromInt :: Int -> Double+fromInt = P.fromIntegral+{-# VECTORISE SCALAR fromInt #-}++truncate, round, ceiling, floor :: Double -> Int+truncate = P.truncate+{-# VECTORISE SCALAR truncate #-}+round = P.round+{-# VECTORISE SCALAR round #-}+ceiling = P.ceiling+{-# VECTORISE SCALAR ceiling #-}+floor = P.floor+{-# VECTORISE SCALAR floor #-}
+ Data/Array/Parallel/Prelude/Float.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE ParallelArrays #-}+{-# OPTIONS_GHC -fvectorise #-}+ -- NB: Cannot use any parallel array syntax except the type constructor++module Data.Array.Parallel.Prelude.Float (+ Float,+ + -- Ord+ (==), (/=), (<), (<=), (>), (>=), min, max,++ minimumP, maximumP, minIndexP, maxIndexP,++ -- Num+ (+), (-), (*), negate, abs,++ sumP, productP,++ -- Fractional+ (/), recip,++ -- Floating+ pi, exp, sqrt, log, (**), logBase,+ sin, tan, cos, asin, atan, acos,+ sinh, tanh, cosh, asinh, atanh, acosh,++ -- RealFrac and similar+ fromInt,++ truncate, round, ceiling, floor,+) where++import Data.Array.Parallel.VectDepend () -- see Note [Vectoriser dependencies] in the same module++import Data.Array.Parallel.PArr+import Data.Array.Parallel.Lifted.Scalar+import Data.Array.Parallel.Lifted.Closure++import Prelude (Float, Int, Bool)+import qualified Prelude as P++infixr 8 **+infixl 7 *, /+infixl 6 +, -+infix 4 ==, /=, <, <=, >, >=++(==), (/=), (<), (<=), (>), (>=) :: Float -> Float -> Bool+(==) = (P.==)+{-# VECTORISE SCALAR (==) #-}+(/=) = (P./=)+{-# VECTORISE SCALAR (/=) #-}+(<=) = (P.<=)+{-# VECTORISE SCALAR (<=) #-}+(<) = (P.<)+{-# VECTORISE SCALAR (<) #-}+(>=) = (P.>=)+{-# VECTORISE SCALAR (>=) #-}+(>) = (P.>)+{-# VECTORISE SCALAR (>) #-}++min, max :: Float -> Float -> Float+min = P.min+{-# VECTORISE SCALAR min #-}+max = P.max+{-# VECTORISE SCALAR max #-}++minimumP, maximumP :: [:Float:] -> Float+{-# NOINLINE minimumP #-}+minimumP a = a `indexPArr` 0+{-# VECTORISE minimumP+ = closure1 (scalar_fold1 P.min) (scalar_fold1s P.min) :: PArray Float :-> Float #-}+{-# NOINLINE maximumP #-}+maximumP a = a `indexPArr` 0+{-# VECTORISE maximumP+ = closure1 (scalar_fold1 P.max) (scalar_fold1s P.max) :: PArray Float :-> Float #-}++minIndexP :: [:Float:] -> Int+{-# NOINLINE minIndexP #-}+minIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE minIndexP = minIndexPA #-}++minIndexPA :: PArray Float :-> Int+{-# INLINE minIndexPA #-}+minIndexPA = closure1 (scalar_fold1Index min') (scalar_fold1sIndex min')+{-# NOVECTORISE minIndexPA #-}++min' (i,x) (j,y) | x P.<= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE min' #-}++maxIndexP :: [:Float:] -> Int+{-# NOINLINE maxIndexP #-}+maxIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE maxIndexP = maxIndexPA #-}++maxIndexPA :: PArray Float :-> Int+{-# INLINE maxIndexPA #-}+maxIndexPA = closure1 (scalar_fold1Index max') (scalar_fold1sIndex max')+{-# NOVECTORISE maxIndexPA #-}++max' (i,x) (j,y) | x P.>= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE max' #-}++(+), (-), (*) :: Float -> Float -> Float+(+) = (P.+)+{-# VECTORISE SCALAR (+) #-}+(-) = (P.-)+{-# VECTORISE SCALAR (-) #-}+(*) = (P.*)+{-# VECTORISE SCALAR (*) #-}++negate, abs :: Float -> Float+negate = P.negate+{-# VECTORISE SCALAR negate #-}+abs = P.abs+{-# VECTORISE SCALAR abs #-}++sumP, productP :: [:Float:] -> Float+{-# NOINLINE sumP #-}+sumP a = a `indexPArr` 0+{-# VECTORISE sumP + = closure1 (scalar_fold (+) 0) (scalar_folds (+) 0) :: PArray Float :-> Float #-}+{-# NOINLINE productP #-}+productP a = a `indexPArr` 0+{-# VECTORISE productP + = closure1 (scalar_fold (*) 1) (scalar_folds (*) 1) :: PArray Float :-> Float #-}++(/) :: Float -> Float -> Float+(/) = (P./)+{-# VECTORISE SCALAR (/) #-}++recip :: Float -> Float+recip = P.recip+{-# VECTORISE SCALAR recip #-}++pi :: Float+pi = P.pi+{-# NOVECTORISE pi #-}++exp, sqrt, log, sin, tan, cos, asin, atan, acos, sinh, tanh, cosh,+ asinh, atanh, acosh :: Float -> Float+exp = P.exp+{-# VECTORISE SCALAR exp #-}+sqrt = P.sqrt+{-# VECTORISE SCALAR sqrt #-}+log = P.log+{-# VECTORISE SCALAR log #-}+sin = P.sin+{-# VECTORISE SCALAR sin #-}+tan = P.tan+{-# VECTORISE SCALAR tan #-}+cos = P.cos+{-# VECTORISE SCALAR cos #-}+asin = P.asin+{-# VECTORISE SCALAR asin #-}+atan = P.atan+{-# VECTORISE SCALAR atan #-}+acos = P.acos+{-# VECTORISE SCALAR acos #-}+sinh = P.sinh+{-# VECTORISE SCALAR sinh #-}+tanh = P.tanh+{-# VECTORISE SCALAR tanh #-}+cosh = P.cosh+{-# VECTORISE SCALAR cosh #-}+asinh = P.asinh+{-# VECTORISE SCALAR asinh #-}+atanh = P.atanh+{-# VECTORISE SCALAR atanh #-}+acosh = P.acosh+{-# VECTORISE SCALAR acosh #-}++(**), logBase :: Float -> Float -> Float+(**) = (P.**)+{-# VECTORISE SCALAR (**) #-}+logBase = P.logBase+{-# VECTORISE SCALAR logBase #-}++fromInt :: Int -> Float+fromInt = P.fromIntegral+{-# VECTORISE SCALAR fromInt #-}++truncate, round, ceiling, floor :: Float -> Int+truncate = P.truncate+{-# VECTORISE SCALAR truncate #-}+round = P.round+{-# VECTORISE SCALAR round #-}+ceiling = P.ceiling+{-# VECTORISE SCALAR ceiling #-}+floor = P.floor+{-# VECTORISE SCALAR floor #-}
+ Data/Array/Parallel/Prelude/Int.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE ParallelArrays #-}+{-# OPTIONS_GHC -fvectorise #-}+ -- NB: Cannot use any parallel array syntax except the type constructor++module Data.Array.Parallel.Prelude.Int (+ Int,+ + -- Ord+ (==), (/=), (<), (<=), (>), (>=), min, max,++ minimumP, maximumP, minIndexP, maxIndexP,++ -- Num+ (+), (-), (*), negate, abs,++ sumP, productP,++ -- Integral+ div, mod, sqrt,+ + -- Enum+ enumFromToP+) where++import Data.Array.Parallel.VectDepend () -- see Note [Vectoriser dependencies] in the same module++import Data.Array.Parallel.PArr+import Data.Array.Parallel.Lifted.Combinators+import Data.Array.Parallel.Lifted.Scalar+import Data.Array.Parallel.Lifted.Closure++import Prelude (Int, Bool)+import qualified Prelude as P++infixl 7 *+infixl 6 +, -+infix 4 ==, /=, <, <=, >, >=+infixl 7 `div`, `mod`++(==), (/=), (<), (<=), (>), (>=) :: Int -> Int -> Bool+(==) = (P.==)+{-# VECTORISE SCALAR (==) #-}+(/=) = (P./=)+{-# VECTORISE SCALAR (/=) #-}+(<=) = (P.<=)+{-# VECTORISE SCALAR (<=) #-}+(<) = (P.<)+{-# VECTORISE SCALAR (<) #-}+(>=) = (P.>=)+{-# VECTORISE SCALAR (>=) #-}+(>) = (P.>)+{-# VECTORISE SCALAR (>) #-}++min, max :: Int -> Int -> Int+min = P.min+{-# VECTORISE SCALAR min #-}+max = P.max+{-# VECTORISE SCALAR max #-}++minimumP, maximumP :: [:Int:] -> Int+{-# NOINLINE minimumP #-}+minimumP a = a `indexPArr` 0+{-# VECTORISE minimumP+ = closure1 (scalar_fold1 P.min) (scalar_fold1s P.min) :: PArray Int :-> Int #-}+{-# NOINLINE maximumP #-}+maximumP a = a `indexPArr` 0+{-# VECTORISE maximumP+ = closure1 (scalar_fold1 P.max) (scalar_fold1s P.max) :: PArray Int :-> Int #-}++minIndexP :: [:Int:] -> Int+{-# NOINLINE minIndexP #-}+minIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE minIndexP = minIndexPA #-}++minIndexPA :: PArray Int :-> Int+{-# INLINE minIndexPA #-}+minIndexPA = closure1 (scalar_fold1Index min') (scalar_fold1sIndex min')+{-# NOVECTORISE minIndexPA #-}++min' (i,x) (j,y) | x P.<= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE min' #-}++maxIndexP :: [:Int:] -> Int+{-# NOINLINE maxIndexP #-}+maxIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE maxIndexP = maxIndexPA #-}++maxIndexPA :: PArray Int :-> Int+{-# INLINE maxIndexPA #-}+maxIndexPA = closure1 (scalar_fold1Index max') (scalar_fold1sIndex max')+{-# NOVECTORISE maxIndexPA #-}++max' (i,x) (j,y) | x P.>= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE max' #-}++(+), (-), (*) :: Int -> Int -> Int+(+) = (P.+)+{-# VECTORISE SCALAR (+) #-}+(-) = (P.-)+{-# VECTORISE SCALAR (-) #-}+(*) = (P.*)+{-# VECTORISE SCALAR (*) #-}++negate, abs :: Int -> Int+negate = P.negate+{-# VECTORISE SCALAR negate #-}+abs = P.abs+{-# VECTORISE SCALAR abs #-}++sumP, productP :: [:Int:] -> Int+{-# NOINLINE sumP #-}+sumP a = a `indexPArr` 0+{-# VECTORISE sumP + = closure1 (scalar_fold (+) 0) (scalar_folds (+) 0) :: PArray Int :-> Int #-}+{-# NOINLINE productP #-}+productP a = a `indexPArr` 0+{-# VECTORISE productP + = closure1 (scalar_fold (*) 1) (scalar_folds (*) 1) :: PArray Int :-> Int #-}++div, mod :: Int -> Int -> Int+div = P.div+{-# VECTORISE SCALAR div #-}+mod = P.mod+{-# VECTORISE SCALAR mod #-}++sqrt :: Int -> Int+sqrt n = P.floor (P.sqrt (P.fromIntegral n) :: P.Double)+{-# VECTORISE SCALAR sqrt #-}++enumFromToP :: Int -> Int -> [:Int:]+{-# NOINLINE enumFromToP #-}+enumFromToP x y = singletonPArr (x + y)+{-# VECTORISE enumFromToP = enumFromToPA_Int #-}
+ Data/Array/Parallel/Prelude/Tuple.hs view
@@ -0,0 +1,15 @@+module Data.Array.Parallel.Prelude.Tuple (+ tup2, tup3+) where+ +import Data.Array.Parallel.Lifted.Closure+import Data.Array.Parallel.Lifted.PArray+import Data.Array.Parallel.PArray.PDataInstances++tup2 :: (PA a, PA b) => a :-> b :-> (a,b)+{-# INLINE tup2 #-}+tup2 = closure2 (,) zipPA#++tup3 :: (PA a, PA b, PA c) => a :-> b :-> c :-> (a,b,c)+{-# INLINE tup3 #-}+tup3 = closure3 (,,) zip3PA#
+ Data/Array/Parallel/Prelude/Word8.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE ParallelArrays #-}+{-# OPTIONS_GHC -fvectorise #-}+ -- NB: Cannot use any parallel array syntax except the type constructor++module Data.Array.Parallel.Prelude.Word8 (+ Word8,+ + -- Ord+ (==), (/=), (<), (<=), (>), (>=), min, max,++ minimumP, maximumP, minIndexP, maxIndexP,++ -- Num+ (+), (-), (*), negate, abs,++ sumP, productP,++ -- Integral+ div, mod, sqrt,+ + toInt, fromInt+) where++import Data.Array.Parallel.VectDepend () -- see Note [Vectoriser dependencies] in the same module++import Data.Array.Parallel.PArr+import Data.Array.Parallel.Lifted.Scalar+import Data.Array.Parallel.Lifted.Closure++import Prelude (Int, Bool)+import Data.Word (Word8)+import qualified Prelude as P++infixl 7 *+infixl 6 +, -+infix 4 ==, /=, <, <=, >, >=+infixl 7 `div`, `mod`++(==), (/=), (<), (<=), (>), (>=) :: Word8 -> Word8 -> Bool+(==) = (P.==)+{-# VECTORISE SCALAR (==) #-}+(/=) = (P./=)+{-# VECTORISE SCALAR (/=) #-}+(<=) = (P.<=)+{-# VECTORISE SCALAR (<=) #-}+(<) = (P.<)+{-# VECTORISE SCALAR (<) #-}+(>=) = (P.>=)+{-# VECTORISE SCALAR (>=) #-}+(>) = (P.>)+{-# VECTORISE SCALAR (>) #-}++min, max :: Word8 -> Word8 -> Word8+min = P.min+{-# VECTORISE SCALAR min #-}+max = P.max+{-# VECTORISE SCALAR max #-}++minimumP, maximumP :: [:Word8:] -> Word8+{-# NOINLINE minimumP #-}+minimumP a = a `indexPArr` 0+{-# VECTORISE minimumP+ = closure1 (scalar_fold1 P.min) (scalar_fold1s P.min) :: PArray Word8 :-> Word8 #-}+{-# NOINLINE maximumP #-}+maximumP a = a `indexPArr` 0+{-# VECTORISE maximumP+ = closure1 (scalar_fold1 P.max) (scalar_fold1s P.max) :: PArray Word8 :-> Word8 #-}++minIndexP :: [:Word8:] -> Int+{-# NOINLINE minIndexP #-}+minIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE minIndexP = minIndexPA #-}++minIndexPA :: PArray Word8 :-> Int+{-# INLINE minIndexPA #-}+minIndexPA = closure1 (scalar_fold1Index min') (scalar_fold1sIndex min')+{-# NOVECTORISE minIndexPA #-}++min' (i,x) (j,y) | x P.<= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE min' #-}++maxIndexP :: [:Word8:] -> Int+{-# NOINLINE maxIndexP #-}+maxIndexP _ = 0 -- FIXME: add proper implementation+{-# VECTORISE maxIndexP = maxIndexPA #-}++maxIndexPA :: PArray Word8 :-> Int+{-# INLINE maxIndexPA #-}+maxIndexPA = closure1 (scalar_fold1Index max') (scalar_fold1sIndex max')+{-# NOVECTORISE maxIndexPA #-}++max' (i,x) (j,y) | x P.>= y = (i,x)+ | P.otherwise = (j,y)+{-# NOVECTORISE max' #-}++(+), (-), (*) :: Word8 -> Word8 -> Word8+(+) = (P.+)+{-# VECTORISE SCALAR (+) #-}+(-) = (P.-)+{-# VECTORISE SCALAR (-) #-}+(*) = (P.*)+{-# VECTORISE SCALAR (*) #-}++negate, abs :: Word8 -> Word8+negate = P.negate+{-# VECTORISE SCALAR negate #-}+abs = P.abs+{-# VECTORISE SCALAR abs #-}++sumP, productP :: [:Word8:] -> Word8+{-# NOINLINE sumP #-}+sumP a = a `indexPArr` 0+{-# VECTORISE sumP + = closure1 (scalar_fold (+) 0) (scalar_folds (+) 0) :: PArray Word8 :-> Word8 #-}+{-# NOINLINE productP #-}+productP a = a `indexPArr` 0+{-# VECTORISE productP + = closure1 (scalar_fold (*) 1) (scalar_folds (*) 1) :: PArray Word8 :-> Word8 #-}++div, mod :: Word8 -> Word8 -> Word8+div = P.div+{-# VECTORISE SCALAR div #-}+mod = P.mod+{-# VECTORISE SCALAR mod #-}++sqrt :: Word8 -> Word8+sqrt n = P.floor (P.sqrt (P.fromIntegral n) :: P.Double)+{-# VECTORISE SCALAR sqrt #-}++toInt :: Word8 -> Int+toInt = P.fromIntegral+{-# VECTORISE SCALAR toInt #-}++fromInt :: Int -> Word8+fromInt = P.fromIntegral+{-# VECTORISE SCALAR fromInt #-}
+ Data/Array/Parallel/VectDepend.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -fvectorise #-}+{-# OPTIONS_HADDOCK hide #-}++-- Note [Vectoriser dependencies]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Some of the modules in 'dph-common' (and hence, 'dph-seq' and 'dph-par') are being vectorised,+-- whereas some other modules in 'dph-common' define names hardwired into the vectoriser — i.e.,+-- the vectoriser panics if those latter modules have not been compiled yet. To avoid build races+-- we need to ensure that all vectoriser dependencies are compiler before any of the vectorised+-- modules is being compiled.+--+-- The present module imports all vectoriser dependencies and we ensure that those are available+-- in vectorised modules by importing the present module into those vectorised modules. In other+-- words, we turn the indirect module dependencies through the vectoriser into explicit module+-- dependencies, which the dependency tracker of the build system will correctly handle.++-- #hide+module Data.Array.Parallel.VectDepend () where++import Data.Array.Parallel.PArray.Base ()+import Data.Array.Parallel.PArray.Scalar ()+import Data.Array.Parallel.PArray.ScalarInstances ()+import Data.Array.Parallel.PArray.PRepr ()+import Data.Array.Parallel.PArray.PReprInstances ()+import Data.Array.Parallel.PArray.PData ()+import Data.Array.Parallel.PArray.PDataInstances ()+import Data.Array.Parallel.PArray.Types ()+import Data.Array.Parallel.Lifted.Closure ()+import Data.Array.Parallel.Lifted.Unboxed ()+import Data.Array.Parallel.Lifted.Scalar ()+import Data.Array.Parallel.Prelude.Tuple ()
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ dph-seq.cabal view
@@ -0,0 +1,68 @@+Name: dph-seq+Version: 0.5.1.1+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: Data structures for Nested Data-Parallel Haskell.++Cabal-Version: >= 1.6+Build-Type: Simple++Library+ -- This Cabal file gets CPPed, then put in ../dhp_par and ../dph_seq+ -- We therefore need to point back at the original location for+ -- where to find the sources++ Exposed-Modules:+ Data.Array.Parallel+ Data.Array.Parallel.Lifted+ Data.Array.Parallel.Prelude+ Data.Array.Parallel.Prelude.Int+ Data.Array.Parallel.Prelude.Word8+ Data.Array.Parallel.Prelude.Float+ Data.Array.Parallel.Prelude.Double+ Data.Array.Parallel.PArray++ Other-Modules:+ Data.Array.Parallel.PArr+ Data.Array.Parallel.PArray.Base+ Data.Array.Parallel.PArray.Scalar+ Data.Array.Parallel.PArray.ScalarInstances+ Data.Array.Parallel.PArray.PRepr+ Data.Array.Parallel.PArray.PReprInstances+ Data.Array.Parallel.PArray.PData+ Data.Array.Parallel.PArray.PDataInstances+ Data.Array.Parallel.PArray.Types+ Data.Array.Parallel.Lifted.PArray+ Data.Array.Parallel.Lifted.Unboxed+ Data.Array.Parallel.Lifted.Scalar+ Data.Array.Parallel.Lifted.TH.Repr+ Data.Array.Parallel.Lifted.Closure+ Data.Array.Parallel.Lifted.Combinators+ Data.Array.Parallel.Prelude.Tuple+ Data.Array.Parallel.Prelude.Bool+ Data.Array.Parallel.VectDepend++ Exposed: False++ Extensions: TypeFamilies, GADTs, RankNTypes,+ BangPatterns, MagicHash, UnboxedTuples, TypeOperators++ GHC-Options: -Odph -funbox-strict-fields -fcpr-off++ Build-Depends: + base == 4.4.*,+ ghc == 7.2.*,+ array == 0.3.*,+ random == 1.0.*,+ template-haskell == 2.6.*,+ dph-base == 0.5.*,+ dph-prim-seq == 0.5.*++ GHC-Options: -fdph-this++ GHC-Options: -package-name dph-seq+