-- Parallel Arrays: Sequential prototype -- -- Authors: Manuel M. T. Chakravarty -- Gabriele Keller -- Created: 26 October 2000 -- -- Version $Revision$ from $Date$ -- -- Copyright (c) 2000 Chakravarty & Keller -- -- This file is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This file is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- --- DESCRIPTION --------------------------------------------------------------- -- -- This module provides unboxed arrays of primitive types as a sequential -- prototype for the parallel arrays of Gabi's SCL. They come with all the -- necessary operations to support flattened Haskell generated from lambdaPA. -- --- DOCU ---------------------------------------------------------------------- -- -- language: Haskell 98 + GHC extensions (unboxed types and byte arrays) -- -- We export the immutable `PArray' only; however, we internally also use a -- mutable variant `MPArray', which allows us an efficient incremental -- definition of the collective structure. -- -- The class `PAE' is quite peculiar. It essentially serves to overload -- array access (which depends on the size of the unboxed value stored in the -- parallel array); however, the actual operations in the class are only to -- be used internally in this module - and therefore, the class `PAE' is -- exported *abstractly*. In fact, most operations work on mutable parallel -- arrays for efficiency. -- -- We shamelessly steal coding tricks from GHC's `ArrayBase', `IArray' & -- friends, but without most of that overloading mess. -- --- TODO ---------------------------------------------------------------------- -- module PArrays ( PAE, PArray, newPArray, (!|), loop, gen ) where import PrelGHC import PrelBase import PrelST import ST infixl 9 !| -- data structures -- --------------- -- * although all `PArray's are represented by the same structure, the -- functions operating on them differ with the element type; hence, we have -- to overload these functions -- integer indexed array (EXPORTED ABSTRACTLY) -- data PArray e = PArray Int ByteArray# -- mutable integer indexed array -- data MPArray s e = MPArray Int (MutableByteArray# s) -- the class of "Parallel Array Element"s (EXPORTED ABSTRACTLY) -- class PAE a where newMPArray :: Int -> ST s (MPArray s a) readMPArray :: MPArray s a -> Int -> ST s a writeMPArray :: MPArray s a -> Int -> a -> ST s () indexPArray :: PArray a -> Int -> a -- exported functions -- ------------------ -- create new parallel array, where all elements are initialised to the given -- values (EXPORTED) -- newPArray :: PAE e => Int -> e -> PArray e newPArray n e = runST (do mpa <- newMPArray n simpleGen n $ -- (**) These three lines instead \i -> writeMPArray mpa i e -- of the following commented return $ unsafeFreezeMPArray mpa) -- out line gives worse code. -- foldr (fill mpa e) (return $ unsafeFreezeMPArray mpa) [0..n-1]) -- a la ArrayBase {-# SPECIALIZE newPArray :: Int -> Int -> PArray Int #-} fill mpa e i next = writeMPArray mpa i e >> next -- indexing of a parallel array (EXPORTED) -- (!|) :: PAE e => PArray e -> Int -> e (!|) = indexPArray -- Gabi's loop (EXPORTED) -- loop :: () -- ?? loop = error "loop?" -- Gabi's gen (EXPORTED) -- gen :: () -- ?? gen = error "gen??" -- instances of `PAE' -- ------------------ instance PAE Int where newMPArray = newMPArrayInt readMPArray = readMPArrayInt writeMPArray = writeMPArrayInt indexPArray = indexPArrayInt newMPArrayInt :: Int -> ST s (MPArray s Int) newMPArrayInt n@(I# n#) = ST $ \s# -> case (newIntArray# n# s#) of {(# s2#, mba# #) -> (# s2#, MPArray n mba# #)} readMPArrayInt :: MPArray s Int -> Int -> ST s Int {-# INLINE readMPArrayInt #-} readMPArrayInt (MPArray _ mba#) (I# i#) = ST $ \s# -> case readIntArray# mba# i# s# of {(# s2#, r# #) -> (# s2#, I# r# #)} writeMPArrayInt :: MPArray s Int -> Int -> Int -> ST s () {-# INLINE writeMPArrayInt #-} writeMPArrayInt (MPArray _ mba#) (I# i#) (I# e#) = ST $ \s# -> case writeIntArray# mba# i# e# s# of {s2# -> (# s2#, () #)} indexPArrayInt :: PArray Int -> Int -> Int {-# INLINE indexPArrayInt #-} indexPArrayInt (PArray _ ba#) (I# i#) = case indexIntArray# ba# i# of {r# -> (I# r#)} -- auxilliary functions -- -------------------- -- unsafely convert a mutable into an immutable array -- unsafeFreezeMPArray :: MPArray s e -> PArray e unsafeFreezeMPArray (MPArray n mba#) = PArray n (unsafeCoerce# mba#) -- simple generator abstraction -- simpleGen :: Monad m => Int -> (Int -> m ()) -> m () {-# INLINE simpleGen #-} simpleGen 0 p = return () simpleGen n p = p (n - 1) >> simpleGen (n - 1) p {- -- That's what we get for a newPArray specialised for Int and using the -- explicitly recursive simpleGen. $wsimpleGen = NO_CCS srt: (0,2)[] \r[ww w] case ww of ds { 0 -> $wlvl1; DEFAULT -> let { stg_c1Qg = NO_CCS srt: (0,1)[] \r[s1] case -# [ds 1] of a { DEFAULT -> let { stg_c1Lg = NO_CCS I#! [a]; } in case w stg_c1Lg s1 of wild { (#,#) new_s r -> $wsimpleGen a w new_s; } }; } in stg_c1Qg }; SRT: [$wsimpleGen, $wlvl1] $w$snewPArray = NO_CCS srt: (0,1)[] \r[ww w] case newIntArray# [ww realWorld#] of wild { (#,#) s2# mba# -> let { stg_c1M1 = NO_CCS[] \r[i] case i of wild1 { I# i# -> case w of wild2 { I# e# -> let { stg_c1Q7 = NO_CCS[] \r[s#] case writeIntArray# [mba# i# e# s#] of s2#1 { DEFAULT -> (#,#) [s2#1 ()] }; } in stg_c1Q7; }; }; } in case $wsimpleGen ww stg_c1M1 s2# of wild1 { (#,#) new_s r -> let { a = NO_CCS I#! [ww]; } in (#,#) [a mba#]; }; }; SRT: [$wsimpleGen] -- the `case w of' could be pulled out of the loop -- stg_c1Q7 builds a superfluous closure (which is immediately entered) -- could we somehow get a specialised version of simpleGen? -}