+{-# 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.Int
import Data.Word
+import Foreign.C.Types
import Foreign.Ptr
import Foreign.StablePtr
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__
-----------------------------------------------------------------------------
-- Class of immutable arrays
--- | Class of array types with immutable bounds
--- (even if the array elements are mutable).
-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
-- 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 #-}
-----------------------------------------------------------------------------
-- 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
- (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word64) where
+instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where
(==) = eqUArray
-instance Ix ix => Ord (UArray ix Bool) 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
+instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) 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
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
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.
projects / haskell-directory.git / blobdiff