[project @ 2006-01-11 11:29:49 by simonmar]
[ghc-base.git] / Data / Array / Base.hs
index 6864362..32f9fcd 100644 (file)
@@ -6,7 +6,7 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable
+-- Portability :  non-portable (MPTCs, uses Control.Monad.ST)
 --
 -- Basis for IArray and MArray.  Not intended for external consumption;
 -- use IArray or MArray instead.
@@ -18,6 +18,8 @@ module Data.Array.Base where
 
 import Prelude
 
+import Control.Monad.ST.Lazy ( strictToLazyST )
+import qualified Control.Monad.ST.Lazy as Lazy (ST)
 import Data.Ix         ( Ix, range, index, rangeSize )
 import Data.Int
 import Data.Word
@@ -200,48 +202,61 @@ listUArrayST (l,u) es = do
 -- the type looks like constrained over 's', which runST doesn't
 -- like. In fact all MArray (STUArray s) instances are polymorphic
 -- wrt. 's', but runST can't know that.
-
--- I would like to write a rule for listUArrayST (or listArray or
+--
+-- More precisely, we'd like to write this:
+--   listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i)
+--             => (i,i) -> [e] -> UArray i e
+--   listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
+--   {-# RULES listArray = listUArray
+-- Then we could call listUArray at any type 'e' that had a suitable
+-- MArray instance.  But sadly we can't, because we don't have quantified 
+-- constraints.  Hence the mass of rules below.
+
+-- I would like also to write a rule for listUArrayST (or listArray or
 -- whatever) applied to unpackCString#. Unfortunately unpackCString#
 -- calls seem to be floated out, then floated back into the middle
 -- of listUArrayST, so I was not able to do this.
 
+#ifdef __GLASGOW_HASKELL__
+type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e
+
 {-# RULES
-"listArray/UArray/Bool"      listArray = \lu (es :: [Bool])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Char"      listArray = \lu (es :: [Char])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int"       listArray = \lu (es :: [Int])         ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word"      listArray = \lu (es :: [Word])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Ptr"       listArray = \lu (es :: [Ptr a])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/FunPtr"    listArray = \lu (es :: [FunPtr a])    ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Float"     listArray = \lu (es :: [Float])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Double"    listArray = \lu (es :: [Double])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/StablePtr" listArray = \lu (es :: [StablePtr a]) ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int8"      listArray = \lu (es :: [Int8])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int16"     listArray = \lu (es :: [Int16])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int32"     listArray = \lu (es :: [Int32])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int64"     listArray = \lu (es :: [Int64])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word8"     listArray = \lu (es :: [Word8])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word16"    listArray = \lu (es :: [Word16])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word32"    listArray = \lu (es :: [Word32])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word64"    listArray = \lu (es :: [Word64])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
+"listArray/UArray/Bool"      listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool
+"listArray/UArray/Char"      listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char
+"listArray/UArray/Int"       listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int
+"listArray/UArray/Word"      listArray 
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word
+"listArray/UArray/Ptr"       listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a)
+"listArray/UArray/FunPtr"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a)
+"listArray/UArray/Float"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float
+"listArray/UArray/Double"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double
+"listArray/UArray/StablePtr" listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a)
+"listArray/UArray/Int8"      listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8
+"listArray/UArray/Int16"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16
+"listArray/UArray/Int32"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32
+"listArray/UArray/Int64"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64
+"listArray/UArray/Word8"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8
+"listArray/UArray/Word16"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16
+"listArray/UArray/Word32"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32
+"listArray/UArray/Word64"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64
     #-}
+#endif
 
 {-# INLINE (!) #-}
 -- | Returns the element of an immutable array at the specified index.
@@ -1071,6 +1086,14 @@ instance MArray (STArray s) e (ST s) where
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 
+instance MArray (STArray s) e (Lazy.ST s) where
+    {-# INLINE newArray #-}
+    newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)
+    {-# INLINE unsafeRead #-}
+    unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
+
 #ifdef __HUGS__
 INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
 #endif
@@ -1650,14 +1673,20 @@ thawSTUArray (UArray l u arr) = do
 
    Note that because the array is possibly not copied, any subsequent
    modifications made to the mutable version of the array may be
-   shared with the immutable version.  It is safe to use, therefore, if
-   the immutable version is never referenced again.
+   shared with the immutable version.  It is only safe to use,
+   therefore, if the immutable array is never referenced again in this
+   thread, and there is no possibility that it can be also referenced
+   in another thread.  If you use an unsafeThaw/write/unsafeFreeze
+   sequence in a multi-threaded setting, then you must ensure that
+   this sequence is atomic with respect to other threads, or a garbage
+   collector crash may result (because the write may be writing to a
+   frozen array).
 
    The non-copying implementation is supported between certain pairs
    of array types only; one constraint is that the array types must
    have identical representations.  In GHC, The following pairs of
    array types have a non-copying O(1) implementation of
-   'unsafeFreeze'.  Because the optimised versions are enabled by
+   'unsafeThaw'.  Because the optimised versions are enabled by
    specialisations, you will need to compile with optimisation (-O) to
    get them.