--- $Id: PArr.hs,v 1.1 2002/02/11 17:11:12 simonmar Exp $
---
--- Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
+{-# OPTIONS_GHC -fparr -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.PArr
+-- Copyright : (c) 2001-2002 Manuel M T Chakravarty & Gabriele Keller
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : Manuel M. T. Chakravarty <chak@cse.unsw.edu.au>
+-- Stability : internal
+-- Portability : non-portable (GHC Extensions)
--
-- Basic implementation of Parallel Arrays.
--
---- DESCRIPTION ---------------------------------------------------------------
---
-- 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
-- * We might want to add bounds checks that can be deactivated.
--
-{-# OPTIONS -fno-implicit-prelude #-}
-
module GHC.PArr (
- [::], -- abstract
+ -- [::], -- Built-in syntax
mapP, -- :: (a -> b) -> [:a:] -> [:b:]
(+:+), -- :: [:a:] -> [:a:] -> [:a:]
fold1P, -- :: (e -> e -> e) -> [:e:] -> e
permuteP, -- :: [:Int:] -> [:e:] -> [:e:]
bpermuteP, -- :: [:Int:] -> [:e:] -> [:e:]
- bpermuteDftP, -- :: [:Int:] -> [:e:] -> [:e:] -> [:e:]
+ dpermuteP, -- :: [:Int:] -> [:e:] -> [:e:] -> [:e:]
crossP, -- :: [:a:] -> [:b:] -> [:(a, b):]
+ crossMapP, -- :: [:a:] -> (a -> [:b:]) -> [:(a, b):]
indexOfP -- :: (a -> Bool) -> [:a:] -> [:Int:]
) where
-import PrelBase
-import PrelST (ST(..), STRep, runST)
-import PrelList
-import PrelShow
-import PrelRead
+#ifndef __HADDOCK__
+
+import Prelude
+
+import GHC.ST ( ST(..), STRep, runST )
+import GHC.Exts ( Int#, Array#, Int(I#), MutableArray#, newArray#,
+ unsafeFreezeArray#, indexArray#, writeArray#, (<#), (>=#) )
infixl 9 !:
infixr 5 +:+
scanlP f z = fst . loop (scanEFL (flip f)) z
scanl1P :: (a -> a -> a) -> [:a:] -> [:a:]
-acanl1P f [::] = error "Prelude.scanl1P: empty array"
+scanl1P f [::] = 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
takeP n = sliceP 0 (n - 1)
dropP :: Int -> [:a:] -> [:a:]
-dropP n a = sliceP (n - 1) (lengthP a - 1) a
+dropP n a = sliceP n (lengthP a - 1) a
splitAtP :: Int -> [:a:] -> ([:a:],[:a:])
splitAtP n xs = (takeP n xs, dropP n xs)
sumP = foldP (+) 0
productP :: (Num a) => [:a:] -> a
-productP = foldP (*) 0
+productP = foldP (*) 1
maximumP :: (Ord a) => [:a:] -> a
maximumP [::] = error "Prelude.maximumP: empty parallel array"
-- 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 definition.
+-- properly fuse the following definitions.
enumFromToP :: Enum a => a -> a -> [:a:]
enumFromToP x y = mapP toEnum (eftInt (fromEnum x) (fromEnum y))
mapP toEnum (efttInt (fromEnum x) (fromEnum y) (fromEnum z))
where
efttInt x y z = scanlP (+) x $
- replicateP ((z - x + 1) `div` delta - 1) delta
+ replicateP (abs (z - x) `div` abs delta + 1) delta
where
delta = y - x
-- (EXPORTED)
--
permuteP :: [:Int:] -> [:e:] -> [:e:]
-permuteP is es = fst $ loop (mapEFL (es!:)) noAL is
+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 result is undefined
--
bpermuteP :: [:Int:] -> [:e:] -> [:e:]
-bpermuteP is es = error "Prelude.bpermuteP: not implemented yet" -- FIXME
+bpermuteP is es = fst $ loop (mapEFL (es!:)) noAL is
--- permute an array according to the back-permutation vector in the first
+-- 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 back-permutation
+-- * any elements in the result that are not covered by the permutation
-- vector assume the value of the corresponding position of the third
-- argument
--
-bpermuteDftP :: [:Int:] -> [:e:] -> [:e:] -> [:e:]
-bpermuteDftP is es = error "Prelude.bpermuteDftP: not implemented yet"-- FIXME
+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)
--
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)
--
arr <- mkPArr n' marr
return (arr, acc))
where
- noElem = error "PrelPArr.loopFromTo: I do not exist!"
+ noElem = error "GHC.PArr.loopFromTo: I do not exist!"
-- unlike standard Haskell arrays, this value represents an
-- internal error
--- actually loop body of `loop'
+-- 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
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'
--
--
indexPArr :: [:e:] -> Int -> e
{-# INLINE indexPArr #-}
-indexPArr (PArr _ arr#) (I# i#) =
- case indexArray# arr# i# of (# e #) -> e
+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 _ marr#) (I# i#) e = ST $ \s# ->
- case writeArray# marr# i# e s# of s'# -> (# s'#, () #)
+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__ */
+
projects / haskell-directory.git / blobdiff