X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FArray.lhs;h=cfeb648ea39004661f5a571ebff14a6b1eb080a7;hb=9c5585613f9850764713eba921937b00cf891b47;hp=c775047539c9c9c074fa024773784658d257411a;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/lib/std/Array.lhs b/ghc/lib/std/Array.lhs
index c775047..cfeb648 100644
--- a/ghc/lib/std/Array.lhs
+++ b/ghc/lib/std/Array.lhs
@@ -1,101 +1,148 @@
+% -----------------------------------------------------------------------------
+% $Id: Array.lhs,v 1.16 2001/04/14 22:27:00 qrczak Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
-
 \section[Array]{Module @Array@}
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
-module  Array ( 
-    module Ix,			-- export all of Ix 
-    Array, 			-- Array type is abstract
+module  Array 
+
+    ( 
+      module Ix			-- export all of Ix 
+    , Array 			-- Array type is abstract
+
+    , array	    -- :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
+    , listArray     -- :: (Ix a) => (a,a) -> [b] -> Array a b
+    , (!)           -- :: (Ix a) => Array a b -> a -> b
+    , bounds        -- :: (Ix a) => Array a b -> (a,a)
+    , indices       -- :: (Ix a) => Array a b -> [a]
+    , elems         -- :: (Ix a) => Array a b -> [b]
+    , assocs        -- :: (Ix a) => Array a b -> [(a,b)]
+    , accumArray    -- :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
+    , (//)          -- :: (Ix a) => Array a b -> [(a,b)] -> Array a b
+    , accum         -- :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
+    , ixmap         -- :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a b
+
+    -- Array instances:
+    --
+    --   Ix a => Functor (Array a)
+    --   (Ix a, Eq b)  => Eq   (Array a b)
+    --   (Ix a, Ord b) => Ord  (Array a b)
+    --   (Ix a, Show a, Show b) => Show (Array a b)
+    --   (Ix a, Read a, Read b) => Read (Array a b)
+    -- 
+
+    -- Implementation checked wrt. Haskell 98 lib report, 1/99.
+
+    ) where
+\end{code}
 
-    array, listArray, (!), bounds, indices, elems, assocs, 
-    accumArray, (//), accum, ixmap
-  ) where
+#ifndef __HUGS__
 
+\begin{code}
+	------------ GHC --------------------
 import Ix
-import PrelList
---import PrelRead
 import PrelArr		-- Most of the hard work is done here
-import PrelBase
+	------------ End of GHC --------------------
+\end{code}
+
+#else
+
+\begin{code}
+	------------ HUGS (rest of file) --------------------
+import PrelPrim ( PrimArray
+		, runST
+		, primNewArray
+	        , primWriteArray
+		, primReadArray
+		, primUnsafeFreezeArray
+		, primIndexArray
+		)
+import Ix
+import List( (\\) )
 
 infixl 9  !, //
 \end{code}
 
 
-
 %*********************************************************
 %*							*
-\subsection{Definitions of array, !, bounds}
+\subsection{The Array type}
 %*							*
 %*********************************************************
 
+
 \begin{code}
+data Array ix elt = Array (ix,ix) (PrimArray elt)
 
-#ifdef USE_FOLDR_BUILD
-{-# INLINE indices #-}
-{-# INLINE elems #-}
-{-# INLINE assocs #-}
-#endif
+array :: Ix a => (a,a) -> [(a,b)] -> Array a b
+array ixs@(ix_start, ix_end) ivs = runST (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"
 
-{-# SPECIALISE listArray :: (Int,Int) -> [b] -> Array Int b #-}
-listArray	      :: (Ix a) => (a,a) -> [b] -> Array a b
-listArray b vs	      =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
+listArray               :: Ix a => (a,a) -> [b] -> Array a b
+listArray b vs          =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
 
-{-# SPECIALISE indices :: Array Int b -> [Int] #-}
-indices		      :: (Ix a) => Array a b -> [a]
-indices		      =  range . bounds
+(!)	                :: Ix a => Array a b -> a -> b
+(Array bounds arr) ! i  = primIndexArray arr (index bounds i)
 
-{-# SPECIALISE elems :: Array Int b -> [b] #-}
-elems		      :: (Ix a) => Array a b -> [b]
-elems a               =  [a!i | i <- indices a]
+bounds                  :: Ix a => Array a b -> (a,a)
+bounds (Array b _)      =  b
 
-{-# SPECIALISE assocs :: Array Int b -> [(Int,b)] #-}
-assocs		      :: (Ix a) => Array a b -> [(a,b)]
-assocs a              =  [(i, a!i) | i <- indices a]
+indices           :: Ix a => Array a b -> [a]
+indices	          = range . bounds
 
-{-# 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
+elems             :: Ix a => Array a b -> [b]
+elems a           =  [a!i | i <- indices 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}
+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)
 
-%*********************************************************
-%*							*
-\subsection{Instance declarations for Array type}
-%*							*
-%*********************************************************
+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)])
 
-\begin{code}
-instance Ix a => Functor (Array a) where
-  map = amap
+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, Eq b)  => Eq (Array a b)  where
-    a == a'  	        =  assocs a == assocs a'
-    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) => 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, 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