{-# LANGUAGE CPP, ParallelArrays, MagicHash, UnboxedTuples #-}
-{-# OPTIONS_GHC -funbox-strict-fields #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- |
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
--- Basic implementation of Parallel Arrays.
---
--- This module has two functions: (1) It defines the interface to the
--- parallel array extension of the Prelude and (2) it provides a vanilla
--- implementation of parallel arrays that does not require to flatten the
--- array code. The implementation is not very optimised.
---
---- DOCU ----------------------------------------------------------------------
---
--- Language: Haskell 98 plus unboxed values and 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
--- operations are not supported on parallel arrays, as they would require the
--- availability of infinite parallel arrays: `iterate', `repeat', and `cycle'.
---
--- The current implementation is quite simple and entirely based on boxed
--- arrays. One disadvantage of boxed arrays is that they require to
--- immediately initialise all newly allocated arrays with an error thunk to
--- keep the garbage collector happy, even if it is guaranteed that the array
--- is fully initialised with different values before passing over the
--- user-visible interface boundary. Currently, no effort is made to use
--- raw memory copy operations to speed things up.
---
---- TODO ----------------------------------------------------------------------
---
--- * We probably want a standard library `PArray' in addition to the prelude
--- extension in the same way as the standard library `List' complements the
--- list functions from the prelude.
---
--- * Currently, functions that emphasis the constructor-based definition of
--- lists (such as, head, last, tail, and init) are not supported.
---
--- Is it worthwhile to support the string processing functions lines,
--- words, unlines, and unwords? (Currently, they are not implemented.)
---
--- It can, however, be argued that it would be worthwhile to include them
--- for completeness' sake; maybe only in the standard library `PArray'.
---
--- * Prescans are often more useful for array programming than scans. Shall
--- we include them into the Prelude or the library?
---
--- * Due to the use of the iterator `loop', we could define some fusion rules
--- in this module.
---
--- * We might want to add bounds checks that can be deactivated.
---
+-- !!!THIS FILE IS ABOUT TO GO AWAY!!!
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:]
+ -- [::] -- Built-in syntax
+ emptyPArr, replicatePArr, singletonPArr, indexPArr, lengthPArr
) where
#ifndef __HADDOCK__
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`
+ unsafeFreezeArray#, indexArray#, {- writeArray#, -} (<#), (>=#) )
-- representation of parallel arrays
--
data [::] e = PArr Int# (Array# e)
+emptyPArr :: [:a:]
+{-# NOINLINE emptyPArr #-}
+emptyPArr = replicatePArr 0 undefined
--- 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
+replicatePArr :: Int -> a -> [:a:]
+{-# NOINLINE replicatePArr #-}
+replicatePArr 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.
+singletonPArr :: a -> [:a:]
+{-# NOINLINE singletonPArr #-}
+singletonPArr e = replicatePArr 1 e
-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 )
+indexPArr :: [:e:] -> Int -> e
+{-# NOINLINE 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#)
+lengthPArr :: [:a:] -> Int
+{-# NOINLINE lengthPArr #-}
+lengthPArr (PArr n# _) = I# n#
-- auxiliary functions
-- -------------------
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#)
-
-#endif /* __HADDOCK__ */
-
+#endif
projects / ghc-base.git / commitdiff