[project @ 2001-03-25 09:57:24 by qrczak]

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

diff --git a/ghc/lib/std/PrelArr.lhs b/ghc/lib/std/PrelArr.lhs
index e930bad..11c6001 100644 (file)
--- a/ghc/lib/std/PrelArr.lhs
+++ b/ghc/lib/std/PrelArr.lhs
@@ -1,6 +1,9 @@
+% -----------------------------------------------------------------------------
+% $Id: PrelArr.lhs,v 1.26 2001/03/25 09:57:24 qrczak Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
+
 \section[PrelArr]{Module @PrelArr@}
 
 Array implementation, @PrelArr@ exports the basic array
@@ -14,13 +17,10 @@ For byte-arrays see @PrelByteArr@.
 module PrelArr where
 
 import {-# SOURCE #-} PrelErr ( error )
-import PrelList (foldl)
 import PrelEnum
 import PrelNum
 import PrelST
 import PrelBase
-import PrelAddr
-import PrelGHC
 import PrelShow
 
 infixl 9  !, //
@@ -275,6 +275,12 @@ type IPr = (Int, Int)
 data Ix ix => Array     ix elt = Array   ix ix (Array# elt)
 data Ix ix => STArray s ix elt = STArray ix ix (MutableArray# s elt)
 
+-- Mutterings about dependent types... ignore!
+-- Array :: ix -> ix -> Array# elt -> Array
+-- Array :: forall { l::int, h::int, l<=h } Int(l) -> Int(h) -> Array#(h-l+1) -> Array(l,h)
+-- Array :: forall { l1,l2::int, h1,h2::int, l1<=h1+1,l2<=h2+1 } 
+--                (Int(l1),Int(l2)) -> (Int(h1),Int(h2)) -> Array#((h1-l1+1)*(h2-l2+1)) -> Array(l1,h1,l2,h2)
+
 
 data STRef s a = STRef (MutVar# s a)
 
@@ -383,16 +389,12 @@ old_array // ivs
        -- copy the old array:
        arr <- thawSTArray old_array
        -- now write the new elements into the new array:
-       fill_it_in arr ivs
-       freezeSTArray arr
+       foldr (fill_one_in arr) (unsafeFreezeSTArray arr) ivs
     )
 
-fill_it_in :: Ix ix => STArray 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 = writeSTArray arr i v >> rst
+{-# INLINE fill_one_in #-}
+fill_one_in :: Ix ix => STArray s ix e -> (ix, e) -> ST s a -> ST s a
+fill_one_in arr (i, v) next = writeSTArray arr i v >> next
 
 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
@@ -414,7 +416,7 @@ accum f old_array ivs
        arr <- thawSTArray old_array
        -- now zap the elements in question with "f":
        zap_with_f f arr ivs
-       freezeSTArray arr
+       unsafeFreezeSTArray arr
     )
 
 
@@ -424,7 +426,7 @@ accumArray f zero ixs ivs
   = runST (do
        arr <- newSTArray ixs zero
        zap_with_f f arr ivs
-       freezeSTArray arr
+       unsafeFreezeSTArray arr
     )
 \end{code}
 
@@ -452,7 +454,6 @@ instance  (Ix a, Show a, Show b) => Show (Array a b)  where
                    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
@@ -460,7 +461,6 @@ instance  (Ix a, Read a, Read b) => Read (Array a b)  where
           (\r -> [(array b as, u) | ("array",s) <- lex r,
                                     (b,t)       <- reads s,
                                     (as,u)      <- reads t   ])
-    readList = readList__ (readsPrec 0)
 -}
 \end{code}
 
@@ -539,17 +539,17 @@ freezeSTArray (STArray l u arr#) = ST $ \ s# ->
     case rangeSize (l,u)     of { I# n# ->
     case freeze arr# n# s# of { (# s2#, frozen# #) ->
     (# s2#, Array l u frozen# #) }}
-  where
-    freeze  :: MutableArray# s ele     -- the thing
-           -> Int#                     -- size of thing to be frozen
-           -> State# s                 -- the Universe and everything
-           -> (# State# s, Array# ele #)
-    freeze m_arr# n# s#
-      = case newArray# n# init s#            of { (# s2#, newarr1# #) ->
-       case copy 0# n# m_arr# newarr1# s2#   of { (# s3#, newarr2# #) ->
-       unsafeFreezeArray# newarr2# s3#
-       }}
-      where
+
+freeze  :: MutableArray# s ele -- the thing
+       -> Int#                 -- size of thing to be frozen
+       -> State# s                     -- the Universe and everything
+       -> (# State# s, Array# ele #)
+freeze m_arr# n# s#
+ = case newArray# n# init s#            of { (# s2#, newarr1# #) ->
+   case copy 0# n# m_arr# newarr1# s2#   of { (# s3#, newarr2# #) ->
+   unsafeFreezeArray# newarr2# s3#
+   }}
+ where
        init = error "freezeArray: element not copied"
 
        copy :: Int# -> Int#
@@ -584,16 +584,16 @@ thawSTArray (Array l u arr#) = ST $ \ s# ->
     case rangeSize (l,u) of { I# n# ->
     case thaw arr# n# s# of { (# s2#, thawed# #) ->
     (# s2#, STArray l u thawed# #)}}
+
+thaw  :: Array# ele            -- the thing
+      -> Int#                  -- size of thing to be thawed
+      -> State# s              -- the Universe and everything
+      -> (# State# s, MutableArray# s ele #)
+
+thaw arr1# n# s#
+  = case newArray# n# init s#        of { (# s2#, newarr1# #) ->
+    copy 0# n# arr1# newarr1# s2# }
   where
-    thaw  :: Array# ele                        -- the thing
-           -> Int#                     -- size of thing to be thawed
-           -> State# s                 -- the Universe and everything
-           -> (# State# s, MutableArray# s ele #)
-
-    thaw arr1# n# s#
-      = case newArray# n# init s#            of { (# s2#, newarr1# #) ->
-       copy 0# n# arr1# newarr1# s2# }
-      where
        init = error "thawSTArray: element not copied"
 
        copy :: Int# -> Int#