ghc/lib/std/PrelPArr.hs

   1 --  $Id: PrelPArr.hs,v 1.2 2002/02/11 08:20:49 chak Exp $
   2 --
   3 --  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
   4 --
   5 --  Basic implementation of Parallel Arrays.
   6 --
   7 --- DESCRIPTION ---------------------------------------------------------------
   8 --
   9 --  This module has two functions: (1) It defines the interface to the
  10 --  parallel array extension of the Prelude and (2) it provides a vanilla
  11 --  implementation of parallel arrays that does not require to flatten the
  12 --  array code.  The implementation is not very optimised.
  13 --
  14 --- DOCU ----------------------------------------------------------------------
  15 --
  16 --  Language: Haskell 98 plus unboxed values and parallel arrays
  17 --
  18 --  The semantic difference between standard Haskell arrays (aka "lazy
  19 --  arrays") and parallel arrays (aka "strict arrays") is that the evaluation
  20 --  of two different elements of a lazy array is independent, whereas in a
  21 --  strict array either non or all elements are evaluated.  In other words,
  22 --  when a parallel array is evaluated to WHNF, all its elements will be
  23 --  evaluated to WHNF.  The name parallel array indicates that all array
  24 --  elements may, in general, be evaluated to WHNF in parallel without any
  25 --  need to resort to speculative evaluation.  This parallel evaluation
  26 --  semantics is also beneficial in the sequential case, as it facilitates
  27 --  loop-based array processing as known from classic array-based languages,
  28 --  such as Fortran.
  29 --
  30 --  The interface of this module is essentially a variant of the list
  31 --  component of the Prelude, but also includes some functions (such as
  32 --  permutations) that are not provided for lists.  The following list
  33 --  operations are not supported on parallel arrays, as they would require the
  34 --  availability of infinite parallel arrays: `iterate', `repeat', and `cycle'.
  35 --
  36 --  The current implementation is quite simple and entirely based on boxed
  37 --  arrays.  One disadvantage of boxed arrays is that they require to
  38 --  immediately initialise all newly allocated arrays with an error thunk to
  39 --  keep the garbage collector happy, even if it is guaranteed that the array
  40 --  is fully initialised with different values before passing over the
  41 --  user-visible interface boundary.  Currently, no effort is made to use
  42 --  raw memory copy operations to speed things up.
  43 --
  44 --- TODO ----------------------------------------------------------------------
  45 --
  46 --  * We probably want a standard library `PArray' in addition to the prelude
  47 --    extension in the same way as the standard library `List' complements the
  48 --    list functions from the prelude.
  49 --
  50 --  * Currently, functions that emphasis the constructor-based definition of
  51 --    lists (such as, head, last, tail, and init) are not supported.
  52 --
  53 --    Is it worthwhile to support the string processing functions lines,
  54 --    words, unlines, and unwords?  (Currently, they are not implemented.)
  55 --
  56 --    It can, however, be argued that it would be worthwhile to include them
  57 --    for completeness' sake; maybe only in the standard library `PArray'.
  58 --
  59 --  * Prescans are often more useful for array programming than scans.  Shall
  60 --    we include them into the Prelude or the library?
  61 --
  62 --  * Due to the use of the iterator `loop', we could define some fusion rules
  63 --    in this module.
  64 --
  65 --  * We might want to add bounds checks that can be deactivated.
  66 --
  67
  68 {-# OPTIONS -fno-implicit-prelude #-}
  69
  70 module PrelPArr (
  71   [::],                 -- abstract
  72
  73   mapP,                 -- :: (a -> b) -> [:a:] -> [:b:]
  74   (+:+),                -- :: [:a:] -> [:a:] -> [:a:]
  75   filterP,              -- :: (a -> Bool) -> [:a:] -> [:a:]
  76   concatP,              -- :: [:[:a:]:] -> [:a:]
  77   concatMapP,           -- :: (a -> [:b:]) -> [:a:] -> [:b:]
  78 --  head, last, tail, init,   -- it's not wise to use them on arrays
  79   nullP,                -- :: [:a:] -> Bool
  80   lengthP,              -- :: [:a:] -> Int
  81   (!:),                 -- :: [:a:] -> Int -> a
  82   foldlP,               -- :: (a -> b -> a) -> a -> [:b:] -> a
  83   foldl1P,              -- :: (a -> a -> a) ->      [:a:] -> a
  84   scanlP,               -- :: (a -> b -> a) -> a -> [:b:] -> [:a:]
  85   scanl1P,              -- :: (a -> a -> a) ->      [:a:] -> [:a:]
  86   foldrP,               -- :: (a -> b -> b) -> b -> [:a:] -> b
  87   foldr1P,              -- :: (a -> a -> a) ->      [:a:] -> a
  88   scanrP,               -- :: (a -> b -> b) -> b -> [:a:] -> [:b:]
  89   scanr1P,              -- :: (a -> a -> a) ->      [:a:] -> [:a:]
  90 --  iterate, repeat,          -- parallel arrays must be finite
  91   replicateP,           -- :: Int -> a -> [:a:]
  92 --  cycle,                    -- parallel arrays must be finite
  93   takeP,                -- :: Int -> [:a:] -> [:a:]
  94   dropP,                -- :: Int -> [:a:] -> [:a:]
  95   splitAtP,             -- :: Int -> [:a:] -> ([:a:],[:a:])
  96   takeWhileP,           -- :: (a -> Bool) -> [:a:] -> [:a:]
  97   dropWhileP,           -- :: (a -> Bool) -> [:a:] -> [:a:]
  98   spanP,                -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])
  99   breakP,               -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])
 100 --  lines, words, unlines, unwords,  -- is string processing really needed
 101   reverseP,             -- :: [:a:] -> [:a:]
 102   andP,                 -- :: [:Bool:] -> Bool
 103   orP,                  -- :: [:Bool:] -> Bool
 104   anyP,                 -- :: (a -> Bool) -> [:a:] -> Bool
 105   allP,                 -- :: (a -> Bool) -> [:a:] -> Bool
 106   elemP,                -- :: (Eq a) => a -> [:a:] -> Bool
 107   notElemP,             -- :: (Eq a) => a -> [:a:] -> Bool
 108   lookupP,              -- :: (Eq a) => a -> [:(a, b):] -> Maybe b
 109   sumP,                 -- :: (Num a) => [:a:] -> a
 110   productP,             -- :: (Num a) => [:a:] -> a
 111   maximumP,             -- :: (Ord a) => [:a:] -> a
 112   minimumP,             -- :: (Ord a) => [:a:] -> a
 113   zipP,                 -- :: [:a:] -> [:b:]          -> [:(a, b)   :]
 114   zip3P,                -- :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]
 115   zipWithP,             -- :: (a -> b -> c)      -> [:a:] -> [:b:] -> [:c:]
 116   zipWith3P,            -- :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]
 117   unzipP,               -- :: [:(a, b)   :] -> ([:a:], [:b:])
 118   unzip3P,              -- :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])
 119
 120   -- overloaded functions
 121   --
 122   enumFromToP,          -- :: Enum a => a -> a      -> [:a:]
 123   enumFromThenToP,      -- :: Enum a => a -> a -> a -> [:a:]
 124
 125   -- the following functions are not available on lists
 126   --
 127   toP,                  -- :: [a] -> [:a:]
 128   fromP,                -- :: [:a:] -> [a]
 129   sliceP,               -- :: Int -> Int -> [:e:] -> [:e:]
 130   foldP,                -- :: (e -> e -> e) -> e -> [:e:] -> e
 131   fold1P,               -- :: (e -> e -> e) ->      [:e:] -> e
 132   permuteP,             -- :: [:Int:] -> [:e:] ->          [:e:]
 133   bpermuteP,            -- :: [:Int:] -> [:e:] ->          [:e:]
 134   bpermuteDftP,         -- :: [:Int:] -> [:e:] -> [:e:] -> [:e:]
 135   crossP,               -- :: [:a:] -> [:b:] -> [:(a, b):]
 136   indexOfP              -- :: (a -> Bool) -> [:a:] -> [:Int:]
 137 ) where
 138
 139 import PrelBase
 140 import PrelST   (ST(..), STRep, runST)
 141 import PrelList
 142 import PrelShow
 143 import PrelRead
 144
 145 infixl 9  !:
 146 infixr 5  +:+
 147 infix  4  `elemP`, `notElemP`
 148
 149
 150 -- representation of parallel arrays
 151 -- ---------------------------------
 152
 153 -- this rather straight forward implementation maps parallel arrays to the
 154 -- internal representation used for standard Haskell arrays in GHC's Prelude
 155 -- (EXPORTED ABSTRACTLY)
 156 --
 157 -- * This definition *must* be kept in sync with `TysWiredIn.parrTyCon'!
 158 --
 159 data [::] e = PArr Int# (Array# e)
 160
 161
 162 -- exported operations on parallel arrays
 163 -- --------------------------------------
 164
 165 -- operations corresponding to list operations
 166 --
 167
 168 mapP   :: (a -> b) -> [:a:] -> [:b:]
 169 mapP f  = fst . loop (mapEFL f) noAL
 170
 171 (+:+)     :: [:a:] -> [:a:] -> [:a:]
 172 a1 +:+ a2  = fst $ loop (mapEFL sel) noAL (enumFromToP 0 (len1 + len2 - 1))
 173                        -- we can't use the [:x..y:] form here for tedious
 174                        -- reasons to do with the typechecker and the fact that
 175                        -- `enumFromToP' is defined in the same module
 176              where
 177                len1 = lengthP a1
 178                len2 = lengthP a2
 179                --
 180                sel i | i < len1  = a1!:i
 181                      | otherwise = a2!:(i - len1)
 182
 183 filterP   :: (a -> Bool) -> [:a:] -> [:a:]
 184 filterP p  = fst . loop (filterEFL p) noAL
 185
 186 concatP     :: [:[:a:]:] -> [:a:]
 187 concatP xss  = foldlP (+:+) [::] xss
 188
 189 concatMapP   :: (a -> [:b:]) -> [:a:] -> [:b:]
 190 concatMapP f  = concatP . mapP f
 191
 192 --  head, last, tail, init,   -- it's not wise to use them on arrays
 193
 194 nullP      :: [:a:] -> Bool
 195 nullP [::]  = True
 196 nullP _     = False
 197
 198 lengthP             :: [:a:] -> Int
 199 lengthP (PArr n# _)  = I# n#
 200
 201 (!:) :: [:a:] -> Int -> a
 202 (!:)  = indexPArr
 203
 204 foldlP     :: (a -> b -> a) -> a -> [:b:] -> a
 205 foldlP f z  = snd . loop (foldEFL (flip f)) z
 206
 207 foldl1P        :: (a -> a -> a) -> [:a:] -> a
 208 foldl1P f [::]  = error "Prelude.foldl1P: empty array"
 209 foldl1P f a     = snd $ loopFromTo 1 (lengthP a - 1) (foldEFL f) (a!:0) a
 210
 211 scanlP     :: (a -> b -> a) -> a -> [:b:] -> [:a:]
 212 scanlP f z  = fst . loop (scanEFL (flip f)) z
 213
 214 scanl1P        :: (a -> a -> a) -> [:a:] -> [:a:]
 215 acanl1P f [::]  = error "Prelude.scanl1P: empty array"
 216 scanl1P f a     = fst $ loopFromTo 1 (lengthP a - 1) (scanEFL f) (a!:0) a
 217
 218 foldrP :: (a -> b -> b) -> b -> [:a:] -> b
 219 foldrP  = error "Prelude.foldrP: not implemented yet" -- FIXME
 220
 221 foldr1P :: (a -> a -> a) -> [:a:] -> a
 222 foldr1P  = error "Prelude.foldr1P: not implemented yet" -- FIXME
 223
 224 scanrP :: (a -> b -> b) -> b -> [:a:] -> [:b:]
 225 scanrP  = error "Prelude.scanrP: not implemented yet" -- FIXME
 226
 227 scanr1P :: (a -> a -> a) -> [:a:] -> [:a:]
 228 scanr1P  = error "Prelude.scanr1P: not implemented yet" -- FIXME
 229
 230 --  iterate, repeat           -- parallel arrays must be finite
 231
 232 replicateP             :: Int -> a -> [:a:]
 233 {-# INLINE replicateP #-}
 234 replicateP n e  = runST (do
 235   marr# <- newArray n e
 236   mkPArr n marr#)
 237
 238 --  cycle                     -- parallel arrays must be finite
 239
 240 takeP   :: Int -> [:a:] -> [:a:]
 241 takeP n  = sliceP 0 (n - 1)
 242
 243 dropP     :: Int -> [:a:] -> [:a:]
 244 dropP n a  = sliceP (n - 1) (lengthP a - 1) a
 245
 246 splitAtP      :: Int -> [:a:] -> ([:a:],[:a:])
 247 splitAtP n xs  = (takeP n xs, dropP n xs)
 248
 249 takeWhileP :: (a -> Bool) -> [:a:] -> [:a:]
 250 takeWhileP  = error "Prelude.takeWhileP: not implemented yet" -- FIXME
 251
 252 dropWhileP :: (a -> Bool) -> [:a:] -> [:a:]
 253 dropWhileP  = error "Prelude.dropWhileP: not implemented yet" -- FIXME
 254
 255 spanP :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])
 256 spanP  = error "Prelude.spanP: not implemented yet" -- FIXME
 257
 258 breakP   :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])
 259 breakP p  = spanP (not . p)
 260
 261 --  lines, words, unlines, unwords,  -- is string processing really needed
 262
 263 reverseP   :: [:a:] -> [:a:]
 264 reverseP a  = permuteP (enumFromThenToP (len - 1) (len - 2) 0) a
 265                        -- we can't use the [:x, y..z:] form here for tedious
 266                        -- reasons to do with the typechecker and the fact that
 267                        -- `enumFromThenToP' is defined in the same module
 268               where
 269                 len = lengthP a
 270
 271 andP :: [:Bool:] -> Bool
 272 andP  = foldP (&&) True
 273
 274 orP :: [:Bool:] -> Bool
 275 orP  = foldP (||) True
 276
 277 anyP   :: (a -> Bool) -> [:a:] -> Bool
 278 anyP p  = orP . mapP p
 279
 280 allP :: (a -> Bool) -> [:a:] -> Bool
 281 allP p  = andP . mapP p
 282
 283 elemP   :: (Eq a) => a -> [:a:] -> Bool
 284 elemP x  = anyP (== x)
 285
 286 notElemP   :: (Eq a) => a -> [:a:] -> Bool
 287 notElemP x  = allP (/= x)
 288
 289 lookupP :: (Eq a) => a -> [:(a, b):] -> Maybe b
 290 lookupP  = error "Prelude.lookupP: not implemented yet" -- FIXME
 291
 292 sumP :: (Num a) => [:a:] -> a
 293 sumP  = foldP (+) 0
 294
 295 productP :: (Num a) => [:a:] -> a
 296 productP  = foldP (*) 0
 297
 298 maximumP      :: (Ord a) => [:a:] -> a
 299 maximumP [::]  = error "Prelude.maximumP: empty parallel array"
 300 maximumP xs    = fold1P max xs
 301
 302 minimumP :: (Ord a) => [:a:] -> a
 303 minimumP [::]  = error "Prelude.minimumP: empty parallel array"
 304 minimumP xs    = fold1P min xs
 305
 306 zipP :: [:a:] -> [:b:] -> [:(a, b):]
 307 zipP  = zipWithP (,)
 308
 309 zip3P :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]
 310 zip3P  = zipWith3P (,,)
 311
 312 zipWithP         :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:]
 313 zipWithP f a1 a2  = let
 314                       len1 = lengthP a1
 315                       len2 = lengthP a2
 316                       len  = len1 `min` len2
 317                     in
 318                     fst $ loopFromTo 0 (len - 1) combine 0 a1
 319                     where
 320                       combine e1 i = (Just $ f e1 (a2!:i), i + 1)
 321
 322 zipWith3P :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]
 323 zipWith3P f a1 a2 a3 = let
 324                         len1 = lengthP a1
 325                         len2 = lengthP a2
 326                         len3 = lengthP a3
 327                         len  = len1 `min` len2 `min` len3
 328                       in
 329                       fst $ loopFromTo 0 (len - 1) combine 0 a1
 330                       where
 331                         combine e1 i = (Just $ f e1 (a2!:i) (a3!:i), i + 1)
 332
 333 unzipP   :: [:(a, b):] -> ([:a:], [:b:])
 334 unzipP a  = (fst $ loop (mapEFL fst) noAL a, fst $ loop (mapEFL snd) noAL a)
 335 -- FIXME: these two functions should be optimised using a tupled custom loop
 336 unzip3P   :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])
 337 unzip3P a  = (fst $ loop (mapEFL fst3) noAL a,
 338               fst $ loop (mapEFL snd3) noAL a,
 339               fst $ loop (mapEFL trd3) noAL a)
 340              where
 341                fst3 (a, _, _) = a
 342                snd3 (_, b, _) = b
 343                trd3 (_, _, c) = c
 344
 345 -- instances
 346 --
 347
 348 instance Eq a => Eq [:a:] where
 349   a1 == a2 | lengthP a1 == lengthP a2 = andP (zipWithP (==) a1 a2)
 350            | otherwise                = False
 351
 352 instance Ord a => Ord [:a:] where
 353   compare a1 a2 = case foldlP combineOrdering EQ (zipWithP compare a1 a2) of
 354                     EQ | lengthP a1 == lengthP a2 -> EQ
 355                        | lengthP a1 <  lengthP a2 -> LT
 356                        | otherwise                -> GT
 357                   where
 358                     combineOrdering EQ    EQ    = EQ
 359                     combineOrdering EQ    other = other
 360                     combineOrdering other _     = other
 361
 362 instance Functor [::] where
 363   fmap = mapP
 364
 365 instance Monad [::] where
 366   m >>= k  = foldrP ((+:+) . k      ) [::] m
 367   m >>  k  = foldrP ((+:+) . const k) [::] m
 368   return x = [:x:]
 369   fail _   = [::]
 370
 371 instance Show a => Show [:a:]  where
 372   showsPrec _  = showPArr . fromP
 373     where
 374       showPArr []     s = "[::]" ++ s
 375       showPArr (x:xs) s = "[:" ++ shows x (showPArr' xs s)
 376
 377       showPArr' []     s = ":]" ++ s
 378       showPArr' (y:ys) s = ',' : shows y (showPArr' ys s)
 379
 380 instance Read a => Read [:a:]  where
 381   readsPrec _ a = [(toP v, rest) | (v, rest) <- readPArr a]
 382     where
 383       readPArr = readParen False (\r -> do
 384                                           ("[:",s) <- lex r
 385                                           readPArr1 s)
 386       readPArr1 s =
 387         (do { (":]", t) <- lex s; return ([], t) }) ++
 388         (do { (x, t) <- reads s; (xs, u) <- readPArr2 t; return (x:xs, u) })
 389
 390       readPArr2 s =
 391         (do { (":]", t) <- lex s; return ([], t) }) ++
 392         (do { (",", t) <- lex s; (x, u) <- reads t; (xs, v) <- readPArr2 u;
 393               return (x:xs, v) })
 394
 395 -- overloaded functions
 396 --
 397
 398 -- Ideally, we would like `enumFromToP' and `enumFromThenToP' to be members of
 399 -- `Enum'.  On the other hand, we really do not want to change `Enum'.  Thus,
 400 -- for the moment, we hope that the compiler is sufficiently clever to
 401 -- properly fuse the following definition.
 402
 403 enumFromToP     :: Enum a => a -> a -> [:a:]
 404 enumFromToP x y  = mapP toEnum (eftInt (fromEnum x) (fromEnum y))
 405   where
 406     eftInt x y = scanlP (+) x $ replicateP (y - x + 1) 1
 407
 408 enumFromThenToP       :: Enum a => a -> a -> a -> [:a:]
 409 enumFromThenToP x y z  =
 410   mapP toEnum (efttInt (fromEnum x) (fromEnum y) (fromEnum z))
 411   where
 412     efttInt x y z = scanlP (+) x $
 413                       replicateP ((z - x + 1) `div` delta - 1) delta
 414       where
 415        delta = y - x
 416
 417 -- the following functions are not available on lists
 418 --
 419
 420 -- create an array from a list (EXPORTED)
 421 --
 422 toP   :: [a] -> [:a:]
 423 toP l  = fst $ loop store l (replicateP (length l) ())
 424          where
 425            store _ (x:xs) = (Just x, xs)
 426
 427 -- convert an array to a list (EXPORTED)
 428 --
 429 fromP   :: [:a:] -> [a]
 430 fromP a  = [a!:i | i <- [0..lengthP a - 1]]
 431
 432 -- cut a subarray out of an array (EXPORTED)
 433 --
 434 sliceP :: Int -> Int -> [:e:] -> [:e:]
 435 sliceP from to a =
 436   fst $ loopFromTo (0 `max` from) (to `min` (lengthP a - 1)) (mapEFL id) noAL a
 437
 438 -- parallel folding (EXPORTED)
 439 --
 440 -- * the first argument must be associative; otherwise, the result is undefined
 441 --
 442 foldP :: (e -> e -> e) -> e -> [:e:] -> e
 443 foldP  = foldlP
 444
 445 -- parallel folding without explicit neutral (EXPORTED)
 446 --
 447 -- * the first argument must be associative; otherwise, the result is undefined
 448 --
 449 fold1P :: (e -> e -> e) -> [:e:] -> e
 450 fold1P  = foldl1P
 451
 452 -- permute an array according to the permutation vector in the first argument
 453 -- (EXPORTED)
 454 --
 455 permuteP       :: [:Int:] -> [:e:] -> [:e:]
 456 permuteP is es  = fst $ loop (mapEFL (es!:)) noAL is
 457
 458 -- permute an array according to the back-permutation vector in the first
 459 -- argument (EXPORTED)
 460 --
 461 -- * the permutation vector must represent a surjective function; otherwise,
 462 --   the result is undefined
 463 --
 464 bpermuteP       :: [:Int:] -> [:e:] -> [:e:]
 465 bpermuteP is es  = error "Prelude.bpermuteP: not implemented yet" -- FIXME
 466
 467 -- permute an array according to the back-permutation vector in the first
 468 -- argument, which need not be surjective (EXPORTED)
 469 --
 470 -- * any elements in the result that are not covered by the back-permutation
 471 --   vector assume the value of the corresponding position of the third
 472 --   argument
 473 --
 474 bpermuteDftP       :: [:Int:] -> [:e:] -> [:e:] -> [:e:]
 475 bpermuteDftP is es  = error "Prelude.bpermuteDftP: not implemented yet"-- FIXME
 476
 477 -- computes the cross combination of two arrays (EXPORTED)
 478 --
 479 crossP       :: [:a:] -> [:b:] -> [:(a, b):]
 480 crossP a1 a2  = fst $ loop combine (0, 0) $ replicateP len ()
 481                 where
 482                   len1 = lengthP a1
 483                   len2 = lengthP a2
 484                   len  = len1 * len2
 485                   --
 486                   combine _ (i, j) = (Just $ (a1!:i, a2!:j), next)
 487                                      where
 488                                        next | (i + 1) == len1 = (0    , j + 1)
 489                                             | otherwise       = (i + 1, j)
 490
 491 {- An alternative implementation
 492    * The one above is certainly better for flattened code, but here where we
 493      are handling boxed arrays, the trade off is less clear.  However, I
 494      think, the above one is still better.
 495
 496 crossP a1 a2  = let
 497                   len1 = lengthP a1
 498                   len2 = lengthP a2
 499                   x1   = concatP $ mapP (replicateP len2) a1
 500                   x2   = concatP $ replicateP len1 a2
 501                 in
 502                 zipP x1 x2
 503  -}
 504
 505 -- computes an index array for all elements of the second argument for which
 506 -- the predicate yields `True' (EXPORTED)
 507 --
 508 indexOfP     :: (a -> Bool) -> [:a:] -> [:Int:]
 509 indexOfP p a  = fst $ loop calcIdx 0 a
 510                 where
 511                   calcIdx e idx | p e       = (Just idx, idx + 1)
 512                                 | otherwise = (Nothing , idx    )
 513
 514
 515 -- auxiliary functions
 516 -- -------------------
 517
 518 -- internally used mutable boxed arrays
 519 --
 520 data MPArr s e = MPArr Int# (MutableArray# s e)
 521
 522 -- allocate a new mutable array that is pre-initialised with a given value
 523 --
 524 newArray             :: Int -> e -> ST s (MPArr s e)
 525 {-# INLINE newArray #-}
 526 newArray (I# n#) e  = ST $ \s1# ->
 527   case newArray# n# e s1# of { (# s2#, marr# #) ->
 528   (# s2#, MPArr n# marr# #)}
 529
 530 -- convert a mutable array into the external parallel array representation
 531 --
 532 mkPArr                           :: Int -> MPArr s e -> ST s [:e:]
 533 {-# INLINE mkPArr #-}
 534 mkPArr (I# n#) (MPArr _ marr#)  = ST $ \s1# ->
 535   case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->
 536   (# s2#, PArr n# arr# #) }
 537
 538 -- general array iterator
 539 --
 540 -- * corresponds to `loopA' from ``Functional Array Fusion'', Chakravarty &
 541 --   Keller, ICFP 2001
 542 --
 543 loop :: (e -> acc -> (Maybe e', acc))    -- mapping & folding, once per element
 544      -> acc                              -- initial acc value
 545      -> [:e:]                            -- input array
 546      -> ([:e':], acc)
 547 {-# INLINE loop #-}
 548 loop mf acc arr = loopFromTo 0 (lengthP arr - 1) mf acc arr
 549
 550 -- general array iterator with bounds
 551 --
 552 loopFromTo :: Int                        -- from index
 553            -> Int                        -- to index
 554            -> (e -> acc -> (Maybe e', acc))
 555            -> acc
 556            -> [:e:]
 557            -> ([:e':], acc)
 558 {-# INLINE loopFromTo #-}
 559 loopFromTo from to mf start arr = runST (do
 560   marr      <- newArray (to - from + 1) noElem
 561   (n', acc) <- trans from to marr arr mf start
 562   arr       <- mkPArr n' marr
 563   return (arr, acc))
 564   where
 565     noElem = error "PrelPArr.loopFromTo: I do not exist!"
 566              -- unlike standard Haskell arrays, this value represents an
 567              -- internal error
 568
 569 -- actually loop body of `loop'
 570 --
 571 -- * for this to be really efficient, it has to be translated with the
 572 --   constructor specialisation phase "SpecConstr" switched on; as of GHC 5.03
 573 --   this requires an optimisation level of at least -O2
 574 --
 575 trans :: Int                            -- index of first elem to process
 576       -> Int                            -- index of last elem to process
 577       -> MPArr s e'                     -- destination array
 578       -> [:e:]                          -- source array
 579       -> (e -> acc -> (Maybe e', acc))  -- mutator
 580       -> acc                            -- initial accumulator
 581       -> ST s (Int, acc)                -- final destination length/final acc
 582 {-# INLINE trans #-}
 583 trans from to marr arr mf start = trans' from 0 start
 584   where
 585     trans' arrOff marrOff acc
 586       | arrOff > to = return (marrOff, acc)
 587       | otherwise   = do
 588                         let (oe', acc') = mf (arr `indexPArr` arrOff) acc
 589                         marrOff' <- case oe' of
 590                                       Nothing -> return marrOff
 591                                       Just e' -> do
 592                                         writeMPArr marr marrOff e'
 593                                         return $ marrOff + 1
 594                         trans' (arrOff + 1) marrOff' acc'
 595
 596
 597 -- common patterns for using `loop'
 598 --
 599
 600 -- initial value for the accumulator when the accumulator is not needed
 601 --
 602 noAL :: ()
 603 noAL  = ()
 604
 605 -- `loop' mutator maps a function over array elements
 606 --
 607 mapEFL   :: (e -> e') -> (e -> () -> (Maybe e', ()))
 608 {-# INLINE mapEFL #-}
 609 mapEFL f  = \e a -> (Just $ f e, ())
 610
 611 -- `loop' mutator that filter elements according to a predicate
 612 --
 613 filterEFL   :: (e -> Bool) -> (e -> () -> (Maybe e, ()))
 614 {-# INLINE filterEFL #-}
 615 filterEFL p  = \e a -> if p e then (Just e, ()) else (Nothing, ())
 616
 617 -- `loop' mutator for array folding
 618 --
 619 foldEFL   :: (e -> acc -> acc) -> (e -> acc -> (Maybe (), acc))
 620 {-# INLINE foldEFL #-}
 621 foldEFL f  = \e a -> (Nothing, f e a)
 622
 623 -- `loop' mutator for array scanning
 624 --
 625 scanEFL   :: (e -> acc -> acc) -> (e -> acc -> (Maybe acc, acc))
 626 {-# INLINE scanEFL #-}
 627 scanEFL f  = \e a -> (Just a, f e a)
 628
 629 -- elementary array operations
 630 --
 631
 632 -- unlifted array indexing
 633 --
 634 indexPArr                       :: [:e:] -> Int -> e
 635 {-# INLINE indexPArr #-}
 636 indexPArr (PArr _ arr#) (I# i#)  =
 637   case indexArray# arr# i# of (# e #) -> e
 638
 639 -- encapsulate writing into a mutable array into the `ST' monad
 640 --
 641 writeMPArr                           :: MPArr s e -> Int -> e -> ST s ()
 642 {-# INLINE writeMPArr #-}
 643 writeMPArr (MPArr _ marr#) (I# i#) e  = ST $ \s# ->
 644   case writeArray# marr# i# e s# of s'# -> (# s'#, () #)