[project @ 2006-01-11 11:29:49 by simonmar]

[ghc-base.git] / Data / Array / Base.hs

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index 12dbb8e..32f9fcd 100644 (file)
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -6,7 +6,7 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- 
 -- 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.
 --
 -- 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 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
 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.
 -- 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.
 
 -- 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
 {-# 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.
 
 {-# INLINE (!) #-}
 -- | Returns the element of an immutable array at the specified index.

@@ -1071,6 +1086,18 @@ instance MArray (STArray s) e (ST s) where
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 
     {-# 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
+

 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
 
 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
 

@@ -1646,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
 
    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
 
    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.
 
    specialisations, you will need to compile with optimisation (-O) to
    get them.