[project @ 1999-12-20 10:34:27 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / Array.lhs

diff --git a/ghc/lib/std/Array.lhs b/ghc/lib/std/Array.lhs
index 715dc73..5ff36c9 100644 (file)
--- a/ghc/lib/std/Array.lhs
+++ b/ghc/lib/std/Array.lhs
@@ -38,15 +38,21 @@ module  Array
 
     ) where
 
+#ifndef __HUGS__
 import Ix
 import PrelList
 import PrelShow
 import PrelArr         -- Most of the hard work is done here
 import PrelBase
+#else
+import Ix
+import List( (\\) )
+#endif
 
 infixl 9  !, //
 \end{code}
 
+#ifndef __HUGS__
 
 
 %*********************************************************
@@ -57,33 +63,15 @@ infixl 9  !, //
 
 \begin{code}
 
-#ifdef USE_FOLDR_BUILD
-{-# INLINE indices #-}
-{-# INLINE elems #-}
-{-# INLINE assocs #-}
-#endif
 
 {-# SPECIALISE listArray :: (Int,Int) -> [b] -> Array Int b #-}
 listArray            :: (Ix a) => (a,a) -> [b] -> Array a b
 listArray b vs       =  array b (zip (range b) vs)
 
-{-# SPECIALISE indices :: Array Int b -> [Int] #-}
-indices                      :: (Ix a) => Array a b -> [a]
-indices                      =  range . bounds
-
-{-# SPECIALISE elems :: Array Int b -> [b] #-}
+{-# INLINE elems #-}
 elems                :: (Ix a) => Array a b -> [b]
 elems a               =  [a!i | i <- indices a]
 
-{-# SPECIALISE assocs :: Array Int b -> [(Int,b)] #-}
-assocs               :: (Ix a) => Array a b -> [(a,b)]
-assocs a              =  [(i, a!i) | i <- indices a]
-
-{-# SPECIALISE amap :: (b -> c) -> Array Int b -> Array Int c #-}
-amap                 :: (Ix a) => (b -> c) -> Array a b -> Array a c
-amap f a              =  array b [(i, f (a!i)) | i <- range b]
-                         where b = bounds a
-
 ixmap                :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
 ixmap b f a           =  array b [(i, a ! f i) | i <- range b]
 \end{code}
@@ -95,30 +83,76 @@ ixmap b f a           =  array b [(i, a ! f i) | i <- range b]
 %*                                                     *
 %*********************************************************
 
+
+#else
 \begin{code}
-instance Ix a => Functor (Array a) where
-  fmap = amap
+data Array ix elt = Array (ix,ix) (PrimArray elt)
+
+array :: Ix a => (a,a) -> [(a,b)] -> Array a b
+array ixs@(ix_start, ix_end) ivs = primRunST (do
+  { mut_arr <- primNewArray (rangeSize ixs) arrEleBottom
+  ; mapM_ (\ (i,v) -> primWriteArray mut_arr (index ixs i) v) ivs 
+  ; arr <- primUnsafeFreezeArray mut_arr
+  ; return (Array ixs arr)
+  }
+  )
+ where
+  arrEleBottom = error "(Array.!): undefined array element"
+
+listArray               :: Ix a => (a,a) -> [b] -> Array a b
+listArray b vs          =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
+
+(!)                    :: Ix a => Array a b -> a -> b
+(Array bounds arr) ! i  = primIndexArray arr (index bounds i)
+
+bounds                  :: Ix a => Array a b -> (a,a)
+bounds (Array b _)      =  b
 
-instance  (Ix a, Eq b)  => Eq (Array a b)  where
-    a == a'            =  assocs a == assocs a'
-    a /= a'            =  assocs a /= assocs a'
+indices           :: Ix a => Array a b -> [a]
+indices                  = range . bounds
+
+elems             :: Ix a => Array a b -> [b]
+elems a           =  [a!i | i <- indices a]
+
+assocs           :: Ix a => Array a b -> [(a,b)]
+assocs a          =  [(i, a!i) | i <- indices a]
+
+(//)              :: Ix a => Array a b -> [(a,b)] -> Array a b
+a // us           =  array (bounds a)
+                        ([(i,a!i) | i <- indices a \\ [i | (i,_) <- us]]
+                         ++ us)
+
+accum             :: Ix a => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
+accum f           =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])
+
+accumArray        :: Ix a => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
+accumArray f z b  =  accum f (array b [(i,z) | i <- range b])
+
+ixmap            :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
+ixmap b f a       =  array b [(i, a ! f i) | i <- range b]
+
+
+instance (Ix a) => Functor (Array a) where
+    fmap f a = array (bounds a) [(i, f(a!i)) | i <- indices a]
+
+instance (Ix a, Eq b) => Eq (Array a b) where
+    a == a'   =   assocs a == assocs a'
+
+instance (Ix a, Ord b) => Ord (Array a b) where
+    a <= a'   =   assocs a <= assocs a'
 
-instance  (Ix a, Ord b) => Ord (Array a b)  where
-    compare a b = compare (assocs a) (assocs b)
 
 instance  (Ix a, Show a, Show b) => Show (Array a b)  where
     showsPrec p a = showParen (p > 9) (
                    showString "array " .
                    shows (bounds a) . showChar ' ' .
                    shows (assocs a)                  )
-    showList = showList__ (showsPrec 0)
 
-{-
 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
     readsPrec p = readParen (p > 9)
-          (\r -> [(array b as, u) | ("array",s) <- lex r,
-                                    (b,t)       <- reads s,
-                                    (as,u)      <- reads t   ])
-    readList = readList__ (readsPrec 0)
--}
+            (\r -> [(array b as, u) | ("array",s) <- lex r,
+                                      (b,t)       <- reads s,
+                                      (as,u)      <- reads t   ])
+
 \end{code}
+#endif