--
-- 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.Ptr
+import Foreign.StablePtr
#ifdef __GLASGOW_HASKELL__
import GHC.Arr ( STArray, unsafeIndex )
import GHC.ST ( ST(..), runST )
import GHC.Base
import GHC.Word ( Word(..) )
-import GHC.Ptr ( Ptr(..), FunPtr(..) )
+import GHC.Ptr ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr )
import GHC.Float ( Float(..), Double(..) )
import GHC.Stable ( StablePtr(..) )
import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
#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.ST ( STArray, ST(..), runST )
+import Hugs.ByteArray
#endif
-import Data.Dynamic
-#include "Dynamic.h"
+import Data.Typeable
+#include "Typeable.h"
#include "MachDeps.h"
-----------------------------------------------------------------------------
-- Class of immutable arrays
--- | Class of array types with bounds
+-- | 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)
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
\lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)
#-}
-#ifdef __GLASGOW_HASKELL__
{-# INLINE listUArrayST #-}
listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)
=> (i,i) -> [e] -> ST s (STUArray s 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 /* __GLASGOW_HASKELL__ */
+#endif
{-# INLINE (!) #-}
-- | Returns the element of an immutable array at the specified index.
{-|
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
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray = Arr.unsafeAccumArray
-#ifdef __GLASGOW_HASKELL__
-----------------------------------------------------------------------------
-- Flat unboxed arrays
-- get the benefits of unboxed arrays (don\'t forget to import
-- "Data.Array.Unboxed" instead of "Data.Array").
--
+#ifdef __GLASGOW_HASKELL__
data UArray i e = UArray !i !i ByteArray#
+#endif
+#ifdef __HUGS__
+data UArray i e = UArray !i !i !ByteArray
+#endif
INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
{-# INLINE unsafeArrayUArray #-}
unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
- => (i,i) -> [(Int, e)] -> ST s (UArray i e)
-unsafeArrayUArray (l,u) ies = do
- marr <- newArray_ (l,u)
+ => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
+unsafeArrayUArray (l,u) ies default_elem = do
+ marr <- newArray (l,u) default_elem
sequence_ [unsafeWrite marr i e | (i, e) <- ies]
unsafeFreezeSTUArray marr
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeFreezeSTUArray #-}
unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, UArray l u arr# #) }
+#endif
+
+#ifdef __HUGS__
+unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
+unsafeFreezeSTUArray (STUArray l u marr) = do
+ arr <- unsafeFreezeMutableByteArray marr
+ return (UArray l u arr)
+#endif
{-# INLINE unsafeReplaceUArray #-}
unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
other -> other
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
-#endif /* __GLASGOW_HASKELL__ */
-----------------------------------------------------------------------------
-- Showing IArrays
showChar ' ' .
shows (assocs a)
-#ifdef __GLASGOW_HASKELL__
-----------------------------------------------------------------------------
-- Flat unboxed arrays: instances
+#ifdef __HUGS__
+unsafeAtBArray :: Storable e => UArray i e -> Int -> e
+unsafeAtBArray (UArray _ _ arr) = readByteArray arr
+#endif
+
instance IArray UArray Bool where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) =
(indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
`neWord#` int2Word# 0#
+#endif
+#ifdef __HUGS__
+ unsafeAt (UArray _ _ arr) i =
+ testBit (readByteArray arr (bOOL_INDEX i)::BitSet) (bOOL_SUBINDEX i)
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Char where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
{-# INLINE unsafeAt #-}
+#ifdef __GLASGOW_HASKELL__
unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Int where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Word where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ 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 #-}
instance IArray UArray (Ptr a) where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
{-# INLINE unsafeAt #-}
+#ifdef __GLASGOW_HASKELL__
unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray (FunPtr a) where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Float where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Double where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray (StablePtr a) where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
+-- bogus StablePtr value for initialising a UArray of StablePtr.
+#ifdef __GLASGOW_HASKELL__
+nullStablePtr = StablePtr (unsafeCoerce# 0#)
+#endif
+#ifdef __HUGS__
+nullStablePtr = castPtrToStablePtr nullPtr
+#endif
+
instance IArray UArray Int8 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Int16 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Int32 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Int64 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Word8 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Word16 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Word32 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
instance IArray UArray Word64 where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
+#endif
+#ifdef __HUGS__
+ unsafeAt = unsafeAtBArray
+#endif
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
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, Show ix) => Show (UArray ix Word64) where
showsPrec = showsIArray
-#endif /* __GLASGOW_HASKELL__ */
-----------------------------------------------------------------------------
-- Mutable arrays
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 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
-#ifdef __GLASGOW_HASKELL__
-----------------------------------------------------------------------------
-- Flat unboxed mutable arrays (ST monad)
-- element type. However, 'STUArray' is strict in its elements - so
-- don\'t use 'STUArray' if you require the non-strictness that
-- 'STArray' provides.
+#ifdef __GLASGOW_HASKELL__
data STUArray s i a = STUArray !i !i (MutableByteArray# s)
+#endif
+#ifdef __HUGS__
+data STUArray s i a = STUArray !i !i !(MutableByteArray s)
+#endif
INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
{-# INLINE bounds #-}
bounds (STUArray l u _) = (l,u)
+#ifdef __GLASGOW_HASKELL__
instance MArray (STUArray s) Bool (ST s) where
{-# INLINE newArray #-}
newArray (l,u) init = ST $ \s1# ->
bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
#endif /* __GLASGOW_HASKELL__ */
+#ifdef __HUGS__
+newMBArray_ :: (Ix i, Storable e) => (i,i) -> ST s (STUArray s i e)
+newMBArray_ = makeArray undefined
+ where
+ makeArray :: (Ix i, Storable e) => e -> (i,i) -> ST s (STUArray s i e)
+ makeArray dummy (l,u) = do
+ marr <- newMutableByteArray (rangeSize (l,u) * sizeOf dummy)
+ return (STUArray l u marr)
+
+unsafeReadMBArray :: Storable e => STUArray s i e -> Int -> ST s e
+unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
+
+unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
+unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
+
+instance MArray (STUArray s) Bool (ST s) where
+ newArray_ (l,u) = do
+ marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
+ return (STUArray l u marr)
+ unsafeRead (STUArray _ _ marr) i = do
+ let ix = bOOL_INDEX i
+ bit = bOOL_SUBINDEX i
+ w <- readMutableByteArray marr ix
+ return (testBit (w::BitSet) bit)
+ unsafeWrite (STUArray _ _ marr) i e = do
+ let ix = bOOL_INDEX i
+ bit = bOOL_SUBINDEX i
+ w <- readMutableByteArray marr ix
+ writeMutableByteArray marr ix
+ (if e then setBit (w::BitSet) bit else clearBit w bit)
+
+instance MArray (STUArray s) Char (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Int (ST s) where
+ newArray_ = newMBArray_
+ 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
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) (FunPtr a) (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Float (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Double (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) (StablePtr a) (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Int8 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Int16 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Int32 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Int64 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Word8 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Word16 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Word32 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+instance MArray (STUArray s) Word64 (ST s) where
+ newArray_ = newMBArray_
+ unsafeRead = unsafeReadMBArray
+ unsafeWrite = unsafeWriteMBArray
+
+type BitSet = Word8
+
+bitSetSize = bitSize (0::BitSet)
+
+bOOL_SCALE :: Int -> Int
+bOOL_SCALE n = (n + bitSetSize - 1) `div` bitSetSize
+
+bOOL_INDEX :: Int -> Int
+bOOL_INDEX i = i `div` bitSetSize
+
+bOOL_SUBINDEX :: Int -> Int
+bOOL_SUBINDEX i = i `mod` bitSetSize
+#endif /* __HUGS__ */
+
-----------------------------------------------------------------------------
-- Freezing
-- 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
#-}
#endif /* __GLASGOW_HASKELL__ */
+#ifdef __HUGS__
+thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
+thawSTUArray (UArray l u arr) = do
+ marr <- thawByteArray arr
+ return (STUArray l u marr)
+#endif
+
-- In-place conversion of immutable arrays to mutable ones places
-- a proof obligation on the user: no other parts of your code can
-- 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
"unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray
#-}
#endif /* __GLASGOW_HASKELL__ */
+
+-- | Casts an 'STUArray' with one element type into one with a
+-- different element type. All the elements of the resulting array
+-- are undefined (unless you know what you\'re doing...).
+
+#ifdef __GLASGOW_HASKELL__
+castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
+castSTUArray (STUArray l u marr#) = return (STUArray l u marr#)
+#endif
+
+#ifdef __HUGS__
+castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
+castSTUArray (STUArray l u marr) = return (STUArray l u marr)
+#endif
projects / ghc-base.git / blobdiff