[project @ 1999-09-12 16:24:46 by sof]

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

diff --git a/ghc/lib/std/PrelArr.lhs b/ghc/lib/std/PrelArr.lhs
index 331bc26..8165fac 100644 (file)
--- a/ghc/lib/std/PrelArr.lhs
+++ b/ghc/lib/std/PrelArr.lhs
@@ -117,40 +117,38 @@ bounds (Array b _)  = b
   = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
     in
     case (indexArray# arr# n#) of
-      (# _, v #) -> v
+      (# v #) -> v
 
-#ifdef USE_FOLDR_BUILD
 {-# INLINE array #-}
-#endif
-array ixs ivs =
-   runST ( ST $ \ s ->
-       case (newArray ixs arrEleBottom)        of { ST new_array_thing ->
-       case (new_array_thing s)                of { (# s#, arr@(MutableArray _ arr#) #) ->
-       let
-        fill_in s1# [] = s1#
-        fill_in s1# ((i,v) : is) =
-               case (index ixs i)              of { I# n# ->
-               case writeArray# arr# n# v s1#  of { s2# -> 
-               fill_in s2# is }}
-       in
-
-       case (fill_in s# ivs)                   of { s1# -> 
-       case (freezeArray arr)                  of { ST freeze_array_thing ->
-       freeze_array_thing s1# }}}})
+array ixs ivs 
+  = case rangeSize ixs                         of { I# n ->
+    runST ( ST $ \ s1 -> 
+       case newArray# n arrEleBottom s1        of { (# s2, marr #) ->
+       foldr (fill ixs marr) (done ixs marr) ivs s2
+    })}
+
+fill :: Ix ix => (ix,ix)  -> MutableArray# s elt
+             -> (ix,elt) -> STRep s a -> STRep s a
+{-# INLINE fill #-}
+fill ixs marr (i,v) next = \s1 -> case index ixs i     of { I# n ->
+                                 case writeArray# marr n v s1  of { s2 ->
+                                 next s2 }}
+
+done :: Ix ix => (ix,ix) -> MutableArray# s elt
+             -> STRep s (Array ix elt)
+{-# INLINE done #-}
+done ixs marr = \s1 -> case unsafeFreezeArray# marr s1         of { (# s2, arr #) ->
+                      (# s2, Array ixs arr #) }
 
 arrEleBottom :: a
 arrEleBottom = error "(Array.!): undefined array element"
 
-fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
-fill_it_in arr lst
-  = foldr fill_one_in (return ()) lst
-  where  -- **** STRICT **** (but that's OK...)
-    fill_one_in (i, v) rst
-      = writeArray arr i v >> rst
 
 -----------------------------------------------------------------------
--- these also go better with magic: (//), accum, accumArray
+-- These also go better with magic: (//), accum, accumArray
+-- *** NB *** We INLINE them all so that their foldr's get to the call site
 
+{-# INLINE (//) #-}
 old_array // ivs
   = runST (do
        -- copy the old array:
@@ -160,17 +158,26 @@ old_array // ivs
        freezeArray arr
     )
 
+fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
+{-# INLINE fill_it_in #-}
+fill_it_in arr lst = foldr (fill_one_in arr) (return ()) lst
+        -- **** STRICT **** (but that's OK...)
+
+fill_one_in arr (i, v) rst = writeArray arr i v >> rst
+
 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
+{-# INLINE zap_with_f #-}
 
 zap_with_f f arr lst
-  = foldr zap_one (return ()) lst
-  where
-    zap_one (i, new_v) rst = do
-        old_v <- readArray  arr i
+  = foldr (zap_one f arr) (return ()) lst
+
+zap_one f arr (i, new_v) rst = do
+        old_v <- readArray arr i
        writeArray arr i (f old_v new_v)
        rst
 
+{-# INLINE accum #-}
 accum f old_array ivs
   = runST (do
        -- copy the old array:
@@ -180,11 +187,12 @@ accum f old_array ivs
        freezeArray arr
     )
 
+{-# INLINE accumArray #-}
 accumArray f zero ixs ivs
   = runST (do
-       arr# <- newArray ixs zero
-       zap_with_f f  arr# ivs
-       freezeArray arr#
+       arr <- newArray ixs zero
+       zap_with_f f arr ivs
+       freezeArray arr
     )
 \end{code}
 
@@ -633,8 +641,16 @@ thawArray (Array ixs arr#) = ST $ \ s# ->
          | cur# ==# end#
            = (# st#, to# #)
          | otherwise
-           = case indexArray#  from# cur#        of { (# _, ele #) ->
+           = case indexArray#  from# cur#        of { (# ele #) ->
              case writeArray# to#   cur# ele st# of { s1# ->
              copy (cur# +# 1#) end# from# to# s1#
              }}
+
+-- this is a quicker version of the above, just flipping the type
+-- (& representation) of an immutable array. And placing a
+-- proof obligation on the programmer.
+unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
+unsafeThawArray (Array ixs arr#) = ST $ \ s# ->
+   case unsafeThawArray# arr# s# of
+      (# s2#, marr# #) -> (# s2#, MutableArray ixs marr# #)
 \end{code}