[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 e5b6428..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.

@@ -546,19 +561,22 @@ instance IArray UArray Int where
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 

-#ifdef __GLASGOW_HASKELL__

 instance IArray UArray Word where
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 instance IArray UArray Word where
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)

+#ifdef __GLASGOW_HASKELL__

     {-# INLINE unsafeAt #-}
     unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
     {-# INLINE unsafeAt #-}
     unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)

+#endif
+#ifdef __HUGS__
+    unsafeAt = unsafeAtBArray
+#endif

     {-# INLINE unsafeReplace #-}
     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
     {-# INLINE unsafeAccum #-}
     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
     {-# INLINE unsafeReplace #-}
     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
     {-# INLINE unsafeAccum #-}
     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)

-#endif

 
 instance IArray UArray (Ptr a) where
     {-# INLINE unsafeArray #-}
 
 instance IArray UArray (Ptr a) where
     {-# INLINE unsafeArray #-}

@@ -798,10 +816,8 @@ instance Ix ix => Eq (UArray ix Char) where
 instance Ix ix => Eq (UArray ix Int) where
     (==) = eqUArray
 
 instance Ix ix => Eq (UArray ix Int) where
     (==) = eqUArray
 

-#ifdef __GLASGOW_HASKELL__

 instance Ix ix => Eq (UArray ix Word) where
     (==) = eqUArray
 instance Ix ix => Eq (UArray ix Word) where
     (==) = eqUArray

-#endif

 
 instance Ix ix => Eq (UArray ix (Ptr a)) where
     (==) = eqUArray
 
 instance Ix ix => Eq (UArray ix (Ptr a)) where
     (==) = eqUArray

@@ -853,10 +869,8 @@ instance Ix ix => Ord (UArray ix Char) where
 instance Ix ix => Ord (UArray ix Int) where
     compare = cmpUArray
 
 instance Ix ix => Ord (UArray ix Int) where
     compare = cmpUArray
 

-#ifdef __GLASGOW_HASKELL__

 instance Ix ix => Ord (UArray ix Word) where
     compare = cmpUArray
 instance Ix ix => Ord (UArray ix Word) where
     compare = cmpUArray

-#endif

 
 instance Ix ix => Ord (UArray ix (Ptr a)) where
     compare = cmpUArray
 
 instance Ix ix => Ord (UArray ix (Ptr a)) where
     compare = cmpUArray

@@ -903,10 +917,8 @@ instance (Ix ix, Show ix) => Show (UArray ix Char) where
 instance (Ix ix, Show ix) => Show (UArray ix Int) where
     showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Int) where
     showsPrec = showsIArray
 

-#ifdef __GLASGOW_HASKELL__

 instance (Ix ix, Show ix) => Show (UArray ix Word) where
     showsPrec = showsIArray
 instance (Ix ix, Show ix) => Show (UArray ix Word) where
     showsPrec = showsIArray

-#endif

 
 instance (Ix ix, Show ix) => Show (UArray ix Float) where
     showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Float) where
     showsPrec = showsIArray

@@ -968,6 +980,10 @@ class (HasBounds a, Monad m) => MArray a e m where
     unsafeRead  :: Ix i => a i e -> Int -> m e
     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 
     unsafeRead  :: Ix i => a i e -> Int -> m e
     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 

+    {-# INLINE newArray #-}
+       -- The INLINE is crucial, because until we know at least which monad    
+       -- we are in, the code below allocates like crazy.  So inline it,
+       -- in the hope that the context will know the monad.

     newArray (l,u) init = do
         marr <- newArray_ (l,u)
         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
     newArray (l,u) init = do
         marr <- newArray_ (l,u)
         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]

@@ -1070,16 +1086,17 @@ instance MArray (STArray s) e (ST s) where
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 

------------------------------------------------------------------------------
--- Typeable instance for STArray
-
-sTArrayTc :: TyCon
-sTArrayTc = mkTyCon "STArray"
+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)

 
 

-instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where
-  typeOf a = mkAppTy sTArrayTc [typeOf ((undefined :: STArray a b c -> a) a),
-                               typeOf ((undefined :: STArray a b c -> b) a),
-                               typeOf ((undefined :: STArray a b c -> c) a)]
+#ifdef __HUGS__
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+#endif

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

@@ -1452,6 +1469,11 @@ instance MArray (STUArray s) Int (ST s) where
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 

+instance MArray (STUArray s) Word (ST s) where
+    newArray_ = newMBArray_
+    unsafeRead = unsafeReadMBArray
+    unsafeWrite = unsafeWriteMBArray
+

 instance MArray (STUArray s) (Ptr a) (ST s) where
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
 instance MArray (STUArray s) (Ptr a) (ST s) where
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray

@@ -1651,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.