This is a multi-part message in MIME format.
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Here is begginings of my second attempt for an STL like library for
Haskell. The only think this version has is Arrays however I plan to
add a lot more. I am almost done with a mutable hash table and I plan
on adding incorporating in other containers such as Ordered Map, Sets,
and Bags, Queues, Dequeues and other similar stuff. I also plan on
working on a general algorithm collection. I will implement both purely
functional containers and truly mutable ones.
This version will compile under ghc 4.02 without optimization and the
June 27 CVS version of ghc with Optimizations. It will also work
through hugs provided you run the files through hscpp. Unlike Edition I
will strive to making sure that my library always makes it through the
latest version of Hugs.
The file Main.hs contains a small test script demonstrating how
PrimArrays can be faster than arrays with bound checking. Although it
is difficult to tell, as the garbage collector gets in the way of my
benchmarks, accumPrimArray is about 50% to 33% faster than the normal
accumArray and my implementation of accumArray also seams to be a little
faster than GHC implantation. I tried profiling the various accums
however I can't seam to get meaningful results form the CVS version of
ghc. (Is the profiler still not working correctly or is it me?).
I am very serious about hammering out a nice STL like library for
Haskell so I would be very interested in early feedback from some of you
Haskell experts out there.
I have attached some of the more interesting files from my library. The
complete set can be found at http://metalab.unc.edu/kevina/abs.tar.
Once again feed back most welcome, especially from the Haskell experts
out on the list.
--
Kevin Atkinson
[EMAIL PROTECTED]
http://metalab.unc.edu/kevina/
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="Container.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="Container.hs"
module Container where
import Prelude hiding (null)
{- Basic container functions. -}
class Name c where
name :: c -> String
class Size c where
size :: c -> Int
class Empty c where
empty :: c
class Null c where
null :: c -> Bool
isEmpty :: c -> Bool
null = isEmpty
isEmpty = null
class Values c v where
values :: c v -> [v]
class ValMap c v1 v2 where
valmap :: (v1 -> v2) -> c v1 -> c v2
instance (Functor c) => ValMap c v1 v2 where
valmap = fmap
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="Assoc.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="Assoc.hs"
module Assoc where
{-
Functions on Associated Containers (Assoc. C.). A Simple Assoc. C.
is a container which is indexed based on the value of its
elements such as Sets and Bags. A Pair Assoc. C. is a Finite Map.
-}
import Container (ValMap(..))
import Prelude hiding (lookup)
import Maybe
class Buckets c where
-- the number of buckets in a hash table
buckets :: c -> Int
class Bounds c i e where
-- the bounds of an array
bounds :: c i e -> (i,i)
class Assocs c i e where
-- convert a container to a list of ...
assocs :: c i e -> [(i,e)]
indices :: c i e -> [i]
keys :: c i e -> [i]
elems :: c i e -> [e]
-- minimal definition: assocs | indices & elems | keys & elems
-- keys and indices are assumed to do the same thing
assocs c = zip (indices c) (elems c)
indices = map fst . assocs
keys = indices
elems = map snd . assocs
class Lookup c i e where
-- finds an elemant in a Pair. Assoc. C. (!) will cause an error
-- if the element is not found
lookup :: i -> c i e -> Maybe e
(!) :: c i e -> i -> e
-- monmal defination: lookup
c ! a = fromJust (lookup a c)
class Find c v where
find :: v -> c v -> Maybe v
findAll :: v -> c v -> [v]
isMember :: v -> c v -> Bool
count :: v -> c v -> Int
-- minimal defination: find | findAll
find v c = listToMaybe$ findAll v c
findAll v c = maybeToList$ find v c
isMember v c = isJust$ find v c
count v c = length$ findAll v c
class Ixmap c i e j where
ixmap :: (j,j) -> (i -> j) -> c i e -> c j e
class Keymap c i e j where
keymap :: (i -> j) -> c i e -> c j e
class Elmap c i e f where
elmap :: (e -> f) -> c i e -> c i f
map_ :: ((i,e) -> f) -> c i e -> c i f
-- minimal defination: map_
elmap f = map_ (\(_,e) -> f e)
instance (Elmap c i e f) => ValMap (c i) e f where
valmap = elmap
class AssocsMap c i e j f where
assocsMap :: ((i,e) -> (j,f)) -> c i e -> c j f
class Insert c v where
-- insert a new element in a Simple Assoc. C.
-- the behavinor of inserting an element that already exisits
-- is implentation dependent (but NOT undefined)
insert :: v -> c v -> c v
insertMany :: [v] -> c v -> c v
-- minimal defination: insert | insertMany
insert v = insertMany [v]
insertMany l c = foldr insert c l
class Replace c i e where
-- inserts an key-value pair in a Pair Assoc. C. If the key
-- already exists replace its value with the new one.
replace :: (i,e) -> c i e -> c i e
replaceMany :: [(i,e)] -> c i e -> c i e
-- minimal defination: replace | replaceMany
replace v = replaceMany [v]
replaceMany l c = foldr replace c l
class Remove c v where
remove :: v -> c v -> c v -- remove a single element that matches
removeAll :: v -> c v -> c v -- remove ALL elements that match
removeMany :: [v] -> c v -> c v
-- minimal defination: remove | removeMany
remove v = removeMany [v]
removeAll = remove
removeMany l c = foldr remove c l
class Erase c i e where
erase :: i -> c i e -> c i e
eraseMany :: [i] -> c i e -> c i e
-- minimal defination: erase | eraseMany
erase i = eraseMany [i]
eraseMany l c = foldr erase c l
{- If accum is like fold1 then accum0 is like fold -}
class Accum c i e where
accum :: (e -> f -> e) -> c i e -> [(i,f)] -> c i e
class Accum0 c i e where
accum0 :: (e -> f -> e) -> e -> c i e -> [(i,f)] -> c i e
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="Mutable.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="Mutable.hs"
module Mutable where
import Maybe
import Monad (liftM)
-- basic mutable refrence
infix 0 =~
class (Monad s) => Reference r v s where
ref :: v -> s (r v)
val :: r v -> s v
(=~) :: r v -> v -> s ()
class (Monad s) => MShow a s where
mshow :: a -> s String
class (Monad s) => MEq a s where
(==~), (/=~) :: a -> a -> s Bool
-- Minimal complete defintion:
-- (==) or (/=)
x /=~ y = liftM not (x ==~ y)
x ==~ y = liftM not (x /=~ y)
class (MEq a s, Monad s) => MOrd a s where
mcompare :: a -> a -> s Ordering
(<~), (<=~), (>=~), (>~) :: a -> a -> s Bool
mmax, mmin :: a -> a -> s a
-- Minimal complete definition:
-- (<=) or compare
-- Using compare can be more efficient for complex types.
mcompare x y =
do i <- x ==~ y
if i then return EQ else do
i <- x <=~ y
if i then return LT else do
return GT
x <=~ y = liftM (/= GT) $ mcompare x y
x <~ y = liftM (== LT) $ mcompare x y
x >=~ y = liftM (/= LT) $ mcompare x y
x >~ y = liftM (== GT) $ mcompare x y
--note that (min x y, max x y) = (x,y) or (y,x)
mmax x y =
do i <- x >=~ y
if i then return x else return y
mmin x y =
do i <- x <~ y
if i then return x else return y
-- basic container
class (Monad s) => MSize m s where
msize :: m -> s Int
class (Monad s) => MNull m s where
mnull, misEmpty :: m -> s Bool
mnull = misEmpty
misEmpty = mnull
class (Monad s) => MValues m v s where
mvalues :: m v -> s [v]
class (Monad s) => MValMap m v1 v2 s where
mvalmap :: (v1 -> v2) -> m v1 -> s (m v2)
class (Monad s) => MFunctor m s where
mfmap :: (v1 -> v2) -> m v1 -> s (m v2)
class SelfMap m v s where
selfMap :: (v -> v) -> m v -> s ()
class (Monad s) => MResize m s where
mresize :: m -> Int -> s ()
class (Monad s) => MDontResize m s where
mdontResize :: m -> s ()
class (Monad s) => FreezeThaw c m s where
freeze, unsafeFreeze :: m -> s c
thaw :: c -> s m
-- assoc container
class (Monad s) => MBuckets m s where
mbuckets :: m -> s Int
class (Monad s) => MBounds c i e s where
mbounds :: c i e -> s (i,i)
class (Monad s) => MAssocs c i e s where
massocs :: c i e -> s [(i,e)]
mindices, mkeys :: c i e -> s [i]
melems :: c i e -> s [e]
massocs c = do i <- mindices c; e <- melems c; return (zip i e)
mindices c = liftM (map fst) (massocs c)
mkeys = mindices
melems c = liftM (map snd) (massocs c)
class (Monad s) => MLookup m i e s where
(!~) :: m i e -> i -> s e
mlookup :: i -> m i e -> s (Maybe e)
(!~) m k = liftM fromJust (mlookup k m)
class (Monad s) => MFind m v s where
mfind :: v -> m v -> s (Maybe v)
mfindAll :: v -> m v -> s [v]
misMember :: v -> m v -> s Bool
mcount :: v -> m v -> s Int
mfind v m = liftM listToMaybe (mfindAll v m)
mfindAll v m = liftM maybeToList (mfind v m)
misMember v m = liftM isJust (mfind v m)
mcount v m = liftM length (mfindAll v m)
class (Monad s) => MElmap c i e f s where
melmap :: (e -> f) -> c i e -> s (c i f)
mmap_ :: ((i,e) -> f) -> c i e -> s (c i f)
melmap f = mmap_ (\(_,e) -> f e)
instance (MElmap c i e f s) => MValMap (c i) e f s where
mvalmap = melmap
-- The number returned is the change in size of the container for MInsert*
-- and MDel*
class (Monad s) => MInsert m v s where
minsert :: v -> m v -> s Int
minsertMany :: [v] -> m v -> s Int
minsert v = minsertMany [v]
minsertMany l m = mapM (`minsert` m) l >>= return . foldl (+) 0
class (Monad s) => MReplace m i e s where
mreplace :: (i,e) -> m i e -> s Int
mreplaceMany :: [(i,e)] -> m i e -> s Int
mreplace v = mreplaceMany [v]
mreplaceMany l m = mapM (`mreplace` m) l >>= return . foldl (+) 0
class (Monad s) => MRemove m v s where
mremove :: v -> m v -> s Int
mremoveAll :: v -> m v -> s Int
mremoveMany :: [v] -> m v -> s Int
mremove v = mremoveMany [v]
mremoveAll = mremove
mremoveMany l m = mapM (`mremove` m) l >>= return . foldl (+) 0
class (Monad s) => MErase m i e s where
merase :: i -> m i e -> s Int
meraseMany :: [i] -> m i e -> s Int
merase v = meraseMany [v]
meraseMany l m = mapM (`merase` m) l >>= return . foldl (+) 0
class (Monad s) => MZap m i e s where
mzap :: i -> (e -> e) -> m i e -> s ()
instance (MZap0 m i e s) => MZap m i e s where
mzap i f m = mzap0 i f undefined m
class (Monad s) => MZap0 m k d s where
mzap0 :: k -> (d -> d) -> d -> m k d -> s ()
instance (MLookup m i e s, MReplace m i e s) => MZap0 m i e s where
mzap0 ix f init m = do x <- mlookup ix m
case x of
Just e -> mreplace (ix,f e) m
Nothing -> mreplace (ix,f init) m
return ()
class (Monad s) => MAccum m i e s where
maccum :: (e -> f -> e) -> m i e -> [(i,f)] -> s ()
instance (MZap m i e s) => MAccum m i e s where
maccum f m l = z l
where z [] = return ()
z ((k,d):t) = do mzap k (`f` d) m; z t
class (Monad s) => MAccum0 m a b s where
maccum0 :: (b -> c -> b) -> b -> m a b -> [(a,c)] -> s ()
instance (MZap0 m i e s) => MAccum0 m i e s where
maccum0 f init m l = do mapM_ (\(k,d)->mzap0 k (`f` d) init m) l; return ()
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="STExtras.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="STExtras.hs"
module STExtras (unsafeRun', runST, ST, NT) where
import ST
import IOExts
#ifdef __GLASGOW_HASKELL__
import PrelGHC
type NT = RealWorld
#else
type NT = ()
#endif
unsafeRun' :: ST NT a -> a
unsafeRun' a = unsafePerformIO$ stToIO a
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="PrimArrayDefn.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="PrimArrayDefn.hs"
module PrimArrayDefn (module PrimArrayDefn, ST, module STExtras) where
{-
A primative array is an array which has an index starting from 0,
and does NOT do bound checkings unless lookup is used. The index
type is ALWAYS an Int.
-}
import Monad
import STExtras
import ST
import Mutable
import Container (Name(..),Size(..))
import Assoc (Bounds(..))
#ifdef __GLASGOW_HASKELL__
import Assoc (Assocs(elems))
import PrelGHC
import PrelBase
import PrelST
data MutPrimArray s i e = M (MutableArray# s e) Int#
data PrimArray i e = A (Array# e) Int#
#else
import Array hiding (bounds)
data MutPrimArray s i e = M (STArray s Int e) !Int
data PrimArray i e = A (Array Int e) !Int
#endif
instance Name (MutPrimArray s Int el) where
name _ = "MutPrimArray"
instance Name (PrimArray Int el) where
name _ = "PrimArray"
mshow' :: (MBounds a b c d, Name (a b c), Show b, Show c, MAssocs a b c d) =>
a b c -> d String
mshow' arr = do
b <- mbounds arr
a <- melems arr
return$ name arr ++ " " ++ show b ++ " " ++ show a
(==*) :: (MSize (c Int el) s, MSize (d Int el) s,
Eq el,
MAssocs c Int el s, MAssocs d Int el s) =>
c Int el -> d Int el -> s Bool
(==*) a b = do
r <- liftM2 (==) (msize a) (msize b)
if r then return True else do
liftM2 (==) (melems a) (melems b)
mcompare' :: (MSize (c Int el) s, MSize (d Int el) s,
Ord el,
MAssocs c Int el s, MAssocs d Int el s) =>
c Int el -> d Int el -> s Ordering
mcompare' a b = do
r <- liftM2 compare (msize a) (msize b)
return r
case r of
EQ -> liftM2 compare (melems a) (melems b)
x -> return x
mbounds' :: (Monad s, Size c) => c -> s (Int,Int)
mbounds' a = return (0,size a-1)
mindices' :: (Monad a, Size b) => b -> a [Int]
mindices' a = return [0..(size a-1)]
melems' :: (Size (c Int el), MLookup c Int el s) => c Int el -> s [el]
melems' a = do i <- mindices' a; mapM (a !~) i
instance MZap (MutPrimArray s) Int el (ST s) where
mzap i f m = do x <- m !~ i; mreplace (i,f x) m; return ()
instance SelfMap (MutPrimArray s Int) el (ST s) where
selfMap f a = do i <- mindices' a; mapM (\x->mzap x f a) i; return ()
mmap_' :: (MSize (c Int el) (ST s),
MAssocs c Int el (ST s)) =>
((Int,el) -> el') -> c Int el -> ST s (MutPrimArray s Int el')
mmap_' f a = do
s <- msize a
l <- massocs a
mlistPrimArray s (map f l)
{- constructors -}
mprimArray :: Int -> [(Int,el)] -> ST s (MutPrimArray s Int el)
mprimArray s l = do
m <- newArray s
mreplaceMany l m
return m
minitPrimArray :: el -> Int -> ST s (MutPrimArray s Int el)
minitPrimArray init s = do
m <- newArray s
let f ix | ix == s = return ()
| otherwise = do mreplace (ix,init) m; f (ix+1)
f 0
return m
maccumPrimArray :: (el -> el' -> el) -> el -> Int -> [(Int,el')]
-> ST s (MutPrimArray s Int el)
maccumPrimArray f i s l = do
m <- minitPrimArray i s
maccum f m l
return m
mlistPrimArray :: Int -> [el] -> ST s (MutPrimArray s Int el)
mlistPrimArray s l = do
m <- newArray s
mreplaceMany (zip [0..] l) m
return m
#ifdef __GLASGOW_HASKELL__
instance MSize (MutPrimArray s Int el) (ST s) where
msize (M _ s) = return$ I# s
instance (Monad mon) => MSize (PrimArray Int el) mon where
msize (A _ s) = return$ I# s
instance Size (MutPrimArray s Int el) where
size (M _ s) = I# s
instance Bounds (MutPrimArray s) Int el where
bounds (M _ s) = (0, I# (s -# 1#) )
instance MLookup (MutPrimArray s) Int el (ST s) where
(!~) (M a _) (I# i) = ST$ \s -> readArray# a i s
mlookup (I# i) (M a s) | i <# 0# || i >=# s = return Nothing
| otherwise = (ST$ \s -> readArray# a i s)
>>= return . Just
#if __GLASGOW_HASKELL__ >= 404
#define EL (# el #)
#else
#define EL (# _, el #)
#endif
instance (Monad mon) => MLookup PrimArray Int el mon where
(!~) (A a _) (I# i) = return$ case indexArray# a i of EL -> el
mlookup (I# i) (A a s) | i <# 0# || i >=# s = return Nothing
| otherwise = return$ Just$
case indexArray# a i of
EL -> el
#undef EL
instance MReplace (MutPrimArray s) Int el (ST s) where
mreplace (I# i,e) (M a _) = ST$ \s -> (# writeArray# a i e s, 0 #)
mreplaceMany l a = do mapM_ (`mreplace` a) l; return 0
instance MAccum (MutPrimArray s) Int el (ST s) where
maccum f (M m _) l = ST$ \s -> (# z s l, () #)
where z s [] = s
z s ((I# ix,el):t) =
case readArray# m ix s of
(# s, x #) -> case writeArray# m ix (x `f` el) s of
s -> z s t
unsafeFreeze' :: MutPrimArray s Int el -> ST s (PrimArray Int el)
unsafeFreeze' (M a s) = do a <- (ST$ \s -> unsafeFreezeArray# a s)
return$ A a s
--freeze' :: MutPrimArray s Int el -> ST s (PrimArray Int el)
freeze' a = melmap id a >>= unsafeFreeze'
--thaw' :: PrimArray Int el -> ST s (MutPrimArray s Int el)
thaw' a = mlistPrimArray (size a) (elems a)
newArray (I# size) = do m <- (ST$ \s -> newArray# size undefined s)
return$ M m size
#else
instance MSize (MutPrimArray s Int el) (ST s) where
msize (M _ s) = return s
instance (Monad mon) => MSize (PrimArray Int el) mon where
msize (A _ s) = return s
instance Size (MutPrimArray s Int el) where
size (M _ s) = s
instance Bounds (MutPrimArray s) Int el where
bounds (M _ s) = (0, s-1 )
instance MLookup (MutPrimArray s) Int el (ST s) where
(!~) (M a _) i = readSTArray a i
mlookup i (M a s) | i < 0 || i >= s = return Nothing
| otherwise = fmap Just $ readSTArray a i
instance (Monad mon) => MLookup PrimArray Int el mon where
(!~) (A a _) i = return$ a ! i
mlookup i (A a s) | i < 0 || i >= s = return Nothing
| otherwise = return$ Just$ a ! i
instance MReplace (MutPrimArray s) Int el (ST s) where
mreplace (i,e) (M a _) = do writeSTArray a i e; return 0
freeze' (M m s) = do a <- freezeSTArray m; return$ A a s
unsafeFreeze' (M m s) = do a <- unsafeFreezeSTArray m; return$ A a s
thaw' (A a s) = do m <- thawSTArray a; return$ M m s
newArray s = do m <- newSTArray (0,s-1) undefined
return$ M m s
#endif
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="AltArrayDefn.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="AltArrayDefn.hs"
module AltArrayDefn (module AltArrayDefn, module STExtras,
module Ix, ST) where
import STExtras
import qualified PrimArrayFT as Prim
import MutPrimArray
import Mutable
import Container (Name(..), Size(..))
import Assoc (Bounds(..), Assocs(..))
import Ix
import Monad (liftM, liftM2)
-- needed because of GHC bug
import Eval
data (Ix i) => MutArray s i e = M (MutPrimArray s Int e) (i,i)
data (Ix i) => Array i e = A ( PrimArray Int e) (i,i)
instance Name (Array i e) where
name _ = "array"
instance Name (MutArray s i e) where
name _ = "mutArray"
mshow' :: (MBounds a b c d, Name (a b c), Show b, Show c, MAssocs a b c d) =>
a b c -> d String
mshow' arr = do
b <- mbounds arr
a <- massocs arr
return$ name arr ++ " " ++ show b ++ " " ++ show a
(==*) :: (MBounds c ix el s, MBounds d ix el s,
Eq ix, Eq el,
MAssocs c ix el s, MAssocs d ix el s) =>
c ix el -> d ix el -> s Bool
(==*) a b = do
r <- liftM2 (==) (mbounds a) (mbounds b)
if r then return True else do
liftM2 (==) (melems a) (melems b)
mcompare' :: (MBounds c ix el s, MBounds d ix el s,
Ord ix, Ord el,
MAssocs c ix el s, MAssocs d ix el s) =>
c ix el -> d ix el -> s Ordering
mcompare' a b = do
r <- liftM2 compare (mbounds a) (mbounds b)
return r
case r of
EQ -> liftM2 compare (melems a) (melems b)
x -> return x
msize' :: (MBounds c i e m, Ix i) => c i e -> m Int
msize' = liftM rangeSize . mbounds
instance (Ix ix) => Size (MutArray s ix el) where
size (M _ r) = rangeSize r
instance (Ix ix) => Bounds (MutArray s) ix el where
bounds (M _ r) = r
instance (Ix ix) => MBounds (MutArray s) ix el (ST s) where
mbounds (M _ r) = return r
instance (Monad mon, Ix ix) => MBounds Array ix el mon where
mbounds (A _ r) = return r
instance (Ix ix) => MAssocs (MutArray s) ix el (ST s) where
mindices (M _ r) = return$ range r
melems (M a _) = melems a
instance (Ix ix, Monad mon) => MAssocs Array ix el mon where
mindices (A _ r) = return$ range r
melems (A a _) = melems a
instance (Ix ix) => MLookup (MutArray s) ix el (ST s) where
(!~) (M a r) i = a !~ index r i
mlookup i (M a r) | inRange r i = liftM Just $ a !~ index r i
| otherwise = return Nothing
instance (Monad mon, Ix ix) => MLookup Array ix el mon where
(!~) (A a r) i = a !~ index r i
mlookup i (A a r) | inRange r i = liftM Just $ a !~ index r i
| otherwise = return Nothing
instance (Ix ix) => MReplace (MutArray s) ix el (ST s) where
mreplace (i,e) (M a r) = mreplace (index r i,e) a
instance (Ix ix) => MZap (MutArray s) ix el (ST s) where
mzap i f (M a r) = do let i' = index r i
x <- a !~ i'
mreplace (i',f x) a
return ()
instance (Ix ix) => SelfMap (MutArray s ix) el (ST s) where
selfMap f (M a _) = selfMap f a
instance (Ix ix) => MElmap (MutArray s) ix el el' (ST s) where
mmap_ f aa@(M a r) = do l <- massocs aa
new <- mlistPrimArray (size a) (map f l)
return$ M new r
instance (Ix ix, Monad mon) => MElmap Array ix el el' mon where
mmap_ f aa@(A a r) = do l <- massocs aa
let new = listPrimArray (size a) (map f l)
return$ A new r
freeze' (M a r) = do a <- Prim.freeze' a; return$ A a r
unsafeFreeze' (M a r) = do a <- Prim.unsafeFreeze' a; return$ A a r
thaw' (A a r) = do m <- Prim.thaw' a; return$ M m r
marray :: Ix a => (a,a) -> [(a,b)] -> ST c (MutArray c a b)
marray r l = do
a <- mprimArray (rangeSize r) (map (\(i,e)->(index r i,e)) l)
return$ M a r
mlistArray :: Ix a => (a,a) -> [b] -> ST c (MutArray c a b)
mlistArray r l = do
let s = rangeSize r
a <- mlistPrimArray s (take s l)
return$ M a r
maccumArray :: Ix a => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> ST d (MutArray d a b)
maccumArray f i r l = do
a <- maccumPrimArray f i (rangeSize r) (map (\(i,e)->(index r i,e)) l)
return$ M a r
--------------EBB527FEAD30E684DE2E6D05
Content-Type: text/plain; charset=us-ascii;
name="Main.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="Main.hs"
module Main where
import Prelude hiding (null, lookup)
import Mutable
import Assoc
import Container
import MutPrimArray
import MutAltArray
import STExtras
import Random
import qualified Array
import Ix
#ifdef __GLASGOW_HASKELL__
import Eval -- this should really not be necessary, however the CVS
-- version of ghc (June 27, 1999) requires it.
-- I think it is a bug.
import CPUTime
num :: Int
num = 100000
#define scc(n) _scc_ n
#else
getCPUTime :: IO Integer
getCPUTime = return 0
num :: Int
num = 1000
#define scc(n)
#endif
l :: [Int]
l = take num$ randomRs (0,98) (mkStdGen 13)
main :: IO ()
main = do bench$ print$ scc("gen") seq (length (show l)) "Evaluating l"
bench$ scc("orig") orig l
bench$ scc("prim") prim l
bench$ scc("norm") norm l
bench com = do s <- getCPUTime
com
f <- getCPUTime
print$ (f-s) `div` (10^9)
prim l = do let a :: PrimArray Int Int
a = accumPrimArray (+) 0 100 $ zip l (repeat 1)
putStr "prim\n"
print$ elems a
norm l = do let a :: Array Int Int
a = accumArray (+) 0 (0,99) $ zip l (repeat 1)
putStr "norm\n"
print$ elems a
orig l = do let a :: Array.Array Int Int
a = Array.accumArray (+) 0 (0,99) $ zip l (repeat 1)
putStr "orig\n"
print$ Array.elems a
--------------EBB527FEAD30E684DE2E6D05--
