+{-# OPTIONS_GHC -fno-bang-patterns #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Data.Array.Base
--
-- 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.
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.Bits
import Data.Int
import Data.Word
+import Foreign.C.Types
import Foreign.Ptr
import Foreign.StablePtr
-import Foreign.Storable
#ifdef __GLASGOW_HASKELL__
import GHC.Arr ( STArray, unsafeIndex )
import GHC.Stable ( StablePtr(..) )
import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
+import GHC.IOBase ( IO(..) )
#endif
#ifdef __HUGS__
+import Data.Bits
+import Foreign.Storable
import qualified Hugs.Array as Arr
import qualified Hugs.ST as ArrST
import Hugs.Array ( unsafeIndex )
import Hugs.ByteArray
#endif
-import Data.Dynamic
+import Data.Typeable
#include "Typeable.h"
#include "MachDeps.h"
-----------------------------------------------------------------------------
-- Class of immutable arrays
--- | Class of array types with bounds
-class HasBounds a where
- -- | Extracts the bounds of an array
- bounds :: Ix i => a i e -> (i,i)
-
{- | Class of immutable array types.
An array type has the form @(a i e)@ where @a@ is the array type
parameterised over both @a@ and @e@, so that instances specialised to
certain element types can be defined.
-}
-class HasBounds a => IArray a e where
+class IArray a e where
+ -- | Extracts the bounds of an immutable array
+ bounds :: Ix i => a i e -> (i,i)
unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e
unsafeAt :: Ix i => a i e -> Int -> e
unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e
has bounds (1,10), and a one-origin 10 by 10 matrix has bounds
((1,1),(10,10)).
-An association is a pair of the form @(i,x)@, which defines the value
-of the array at index @i@ to be @x@. The array is undefined if any
-index in the list is out of bounds. If any two associations in the
-list have the same index, the value at that index is undefined.
+An association is a pair of the form @(i,x)@, which defines the value of
+the array at index @i@ to be @x@. The array is undefined if any index
+in the list is out of bounds. If any two associations in the list have
+the same index, the value at that index is implementation-dependent.
+(In GHC, the last value specified for that index is used.
+Other implementations will also do this for unboxed arrays, but Haskell
+98 requires that for 'Array' the value at such indices is bottom.)
Because the indices must be checked for these errors, 'array' is
strict in the bounds argument and in the indices of the association
-- 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.
{-# INLINE indices #-}
-- | Returns a list of all the valid indices in an array.
-indices :: (HasBounds a, Ix i) => a i e -> [i]
+indices :: (IArray a e, Ix i) => a i e -> [i]
indices arr = case bounds arr of (l,u) -> range (l,u)
{-# INLINE elems #-}
{-|
Takes an array and a list of pairs and returns an array identical to
the left argument except that it has been updated by the associations
-in the right argument. (As with the array function, the indices in the
-association list must be unique for the updated elements to be
-defined.) For example, if m is a 1-origin, n by n matrix, then
-@m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with the
-diagonal zeroed.
+in the right argument. For example, if m is a 1-origin, n by n matrix,
+then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with
+the diagonal zeroed.
+
+As with the 'array' function, if any two associations in the list have
+the same index, the value at that index is implementation-dependent.
+(In GHC, the last value specified for that index is used.
+Other implementations will also do this for unboxed arrays, but Haskell
+98 requires that for 'Array' the value at such indices is bottom.)
For most array types, this operation is O(/n/) where /n/ is the size
of the array. However, the 'Data.Array.Diff.DiffArray' type provides
-----------------------------------------------------------------------------
-- Normal polymorphic arrays
-instance HasBounds Arr.Array where
+instance IArray Arr.Array e where
{-# INLINE bounds #-}
bounds = Arr.bounds
-
-instance IArray Arr.Array e where
{-# INLINE unsafeArray #-}
unsafeArray = Arr.unsafeArray
{-# INLINE unsafeAt #-}
INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
-instance HasBounds UArray where
- {-# INLINE bounds #-}
- bounds (UArray l u _) = (l,u)
-
{-# INLINE unsafeArrayUArray #-}
unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
=> (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
#endif
instance IArray UArray Bool where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Char where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
{-# INLINE unsafeAt #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Int where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-#ifdef __GLASGOW_HASKELL__
instance IArray UArray Word where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# 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)
-#endif
instance IArray UArray (Ptr a) where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
{-# INLINE unsafeAt #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray (FunPtr a) where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Float where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Double where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray (StablePtr a) where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
#ifdef __GLASGOW_HASKELL__
#endif
instance IArray UArray Int8 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Int16 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Int32 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Int64 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Word8 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Word16 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Word32 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
instance IArray UArray Word64 where
+ {-# INLINE bounds #-}
+ bounds (UArray l u _) = (l,u)
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-instance Ix ix => Eq (UArray ix Bool) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Char) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int) where
- (==) = eqUArray
-
-#ifdef __GLASGOW_HASKELL__
-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 (FunPtr a)) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Float) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Double) where
- (==) = eqUArray
-
-#ifdef __GLASGOW_HASKELL__
-instance Ix ix => Eq (UArray ix (StablePtr a)) where
- (==) = eqUArray
-#endif
-
-instance Ix ix => Eq (UArray ix Int8) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int16) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int32) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int64) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word8) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word16) where
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word32) where
+instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where
(==) = eqUArray
-instance Ix ix => Eq (UArray ix Word64) where
- (==) = eqUArray
-
-instance Ix ix => Ord (UArray ix Bool) where
+instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where
compare = cmpUArray
-instance Ix ix => Ord (UArray ix Char) 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
-#endif
-
-instance Ix ix => Ord (UArray ix (Ptr a)) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix (FunPtr a)) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Float) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Double) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int8) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int16) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int32) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int64) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word8) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word16) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word32) where
- compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word64) where
- compare = cmpUArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Bool) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Char) 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
-#endif
-
-instance (Ix ix, Show ix) => Show (UArray ix Float) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Double) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int8) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int16) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int32) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int64) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word8) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word16) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word32) where
- showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word64) where
+instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where
showsPrec = showsIArray
-----------------------------------------------------------------------------
same way as for 'IArray'), and also over the type of the monad, @m@,
in which the mutable array will be manipulated.
-}
-class (HasBounds a, Monad m) => MArray a e m where
+class (Monad m) => MArray a e m where
+
+ -- | Returns the bounds of the array
+ getBounds :: Ix i => a i e -> m (i,i)
-- | Builds a new array, with every element initialised to the supplied
-- value.
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]]
{-# INLINE readArray #-}
-- | Read an element from a mutable array
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
-readArray marr i = case bounds marr of
- (l,u) -> unsafeRead marr (index (l,u) i)
+readArray marr i = do
+ (l,u) <- getBounds marr
+ unsafeRead marr (index (l,u) i)
{-# INLINE writeArray #-}
-- | Write an element in a mutable array
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
-writeArray marr i e = case bounds marr of
- (l,u) -> unsafeWrite marr (index (l,u) i) e
+writeArray marr i e = do
+ (l,u) <- getBounds marr
+ unsafeWrite marr (index (l,u) i) e
{-# INLINE getElems #-}
-- | Return a list of all the elements of a mutable array
getElems :: (MArray a e m, Ix i) => a i e -> m [e]
-getElems marr = case bounds marr of
- (l,u) -> sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
+getElems marr = do
+ (l,u) <- getBounds marr
+ sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
{-# INLINE getAssocs #-}
-- | Return a list of all the associations of a mutable array, in
-- index order.
getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
-getAssocs marr = case bounds marr of
- (l,u) -> sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
- | i <- range (l,u)]
+getAssocs marr = do
+ (l,u) <- getBounds marr
+ sequence [ do e <- unsafeRead marr (index (l,u) i); return (i,e)
+ | i <- range (l,u)]
{-# INLINE mapArray #-}
-- | Constructs a new array derived from the original array by applying a
-- function to each of the elements.
mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
-mapArray f marr = case bounds marr of
- (l,u) -> do
- marr' <- newArray_ (l,u)
- sequence_ [do
+mapArray f marr = do
+ (l,u) <- getBounds marr
+ marr' <- newArray_ (l,u)
+ sequence_ [do
e <- unsafeRead marr i
unsafeWrite marr' i (f e)
| i <- [0 .. rangeSize (l,u) - 1]]
- return marr'
+ return marr'
{-# INLINE mapIndices #-}
-- | Constructs a new array derived from the original array by applying a
-----------------------------------------------------------------------------
-- Polymorphic non-strict mutable arrays (ST monad)
-instance HasBounds (STArray s) where
- {-# INLINE bounds #-}
- bounds = ArrST.boundsSTArray
-
instance MArray (STArray s) e (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds arr = return $! ArrST.boundsSTArray arr
{-# INLINE newArray #-}
newArray = ArrST.newSTArray
{-# INLINE unsafeRead #-}
{-# INLINE unsafeWrite #-}
unsafeWrite = ArrST.unsafeWriteSTArray
------------------------------------------------------------------------------
--- Typeable instance for STArray
-
-sTArrayTc :: TyCon
-sTArrayTc = mkTyCon "STArray"
+instance MArray (STArray s) e (Lazy.ST s) where
+ {-# INLINE getBounds #-}
+ getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)
+ {-# 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)
INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
-instance HasBounds (STUArray s) where
- {-# INLINE bounds #-}
- bounds (STUArray l u _) = (l,u)
-
#ifdef __GLASGOW_HASKELL__
instance MArray (STUArray s) Bool (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray #-}
newArray (l,u) init = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s3#, () #) }}}}
instance MArray (STUArray s) Char (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Int (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Word (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) (Ptr a) (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) (FunPtr a) (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Float (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Double (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) (StablePtr a) (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Int8 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Int16 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Int32 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Int64 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Word8 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Word16 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Word32 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
(# s2#, () #) }
instance MArray (STUArray s) Word64 (ST s) where
+ {-# INLINE getBounds #-}
+ getBounds (STUArray l u _) = return (l,u)
{-# INLINE newArray_ #-}
newArray_ (l,u) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
+getBoundsMBArray (STUArray l u _) = return (l,u)
+
instance MArray (STUArray s) Bool (ST s) where
+ getBounds = getBoundsMBArray
newArray_ (l,u) = do
marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
return (STUArray l u marr)
(if e then setBit (w::BitSet) bit else clearBit w bit)
instance MArray (STUArray s) Char (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Int (ST s) where
+ getBounds = getBoundsMBArray
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Word (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) (Ptr a) (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) (FunPtr a) (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Float (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Double (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) (StablePtr a) (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Int8 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Int16 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Int32 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Int64 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Word8 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Word16 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Word32 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
instance MArray (STUArray s) Word64 (ST s) where
+ getBounds = getBoundsMBArray
newArray_ = newMBArray_
unsafeRead = unsafeReadMBArray
unsafeWrite = unsafeWriteMBArray
-- immutable array (any instance of 'IArray') by taking a complete
-- copy of it.
freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
-freeze marr = case bounds marr of
- (l,u) -> do
- ies <- sequence [do e <- unsafeRead marr i; return (i,e)
- | i <- [0 .. rangeSize (l,u) - 1]]
- return (unsafeArray (l,u) ies)
+freeze marr = do
+ (l,u) <- getBounds marr
+ ies <- sequence [do e <- unsafeRead marr i; return (i,e)
+ | i <- [0 .. rangeSize (l,u) - 1]]
+ return (unsafeArray (l,u) ies)
#ifdef __GLASGOW_HASKELL__
freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
case sizeofMutableByteArray# marr# of { n# ->
case newByteArray# n# s1# of { (# s2#, marr'# #) ->
- case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
+ case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->
+ case unsafeCoerce# m s2# of { (# s3#, _ #) ->
case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
- (# s4#, UArray l u arr# #) }}}}
+ (# s4#, UArray l u arr# #) }}}}}
+
+foreign import ccall unsafe "memcpy"
+ memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize
+ -> IO (Ptr a)
{-# RULES
"freeze/STArray" freeze = ArrST.freezeSTArray
-- have a reference to the array at the point where you unsafely
-- freeze it (and, subsequently mutate it, I suspect).
-{-# INLINE unsafeFreeze #-}
+{- |
+ Converts an mutable array into an immutable array. The
+ implementation may either simply cast the array from
+ one type to the other without copying the array, or it
+ may take a full copy of the array.
+
+ 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 mutable version is never modified after the freeze operation.
+
+ 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
+ specialisations, you will need to compile with optimisation (-O) to
+ get them.
+
+ * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'
+
+ * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'
--- | Converts a mutable array to an immutable array /without taking a
--- copy/. This function is \"unsafe\" because if any further
--- modifications are made to the original mutable array then they will
--- be shared with the immutable version. It is safe to use,
--- therefore, if the mutable version is never modified after the
--- freeze operation.
+ * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'
+
+ * 'Data.Array.ST.STArray' -> 'Data.Array.Array'
+-}
+{-# INLINE unsafeFreeze #-}
unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
unsafeFreeze = freeze
thawSTUArray (UArray l u arr#) = ST $ \s1# ->
case sizeofByteArray# arr# of { n# ->
case newByteArray# n# s1# of { (# s2#, marr# #) ->
- case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
- (# s3#, STUArray l u marr# #) }}}
+ case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->
+ case unsafeCoerce# m s2# of { (# s3#, _ #) ->
+ (# s3#, STUArray l u marr# #) }}}}
foreign import ccall unsafe "memcpy"
- memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
+ memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize
+ -> IO (Ptr a)
{-# RULES
"thaw/STArray" thaw = ArrST.thawSTArray
-- have a reference to the array at the point where you unsafely
-- thaw it (and, subsequently mutate it, I suspect).
+{- |
+ Converts an immutable array into a mutable array. The
+ implementation may either simply cast the array from
+ one type to the other without copying the array, or it
+ may take a full copy of the array.
+
+ 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 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
+ 'unsafeThaw'. Because the optimised versions are enabled by
+ specialisations, you will need to compile with optimisation (-O) to
+ get them.
+
+ * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'
+
+ * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'
+
+ * 'Data.Array.Array' -> 'Data.Array.IO.IOArray'
+
+ * 'Data.Array.Array' -> 'Data.Array.ST.STArray'
+-}
{-# INLINE unsafeThaw #-}
-
--- | Converts an immutable array into a mutable array /without taking
--- a copy/. This function is \"unsafe\" because any subsequent
--- modifications made to the mutable version of the array will be
--- shared with the immutable version. It is safe to use, therefore, if
--- the immutable version is never referenced again.
unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
unsafeThaw = thaw
projects / haskell-directory.git / blobdiff