-{-# OPTIONS -monly-3-regs #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Array.Base
import Prelude
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 qualified GHC.Arr
+import qualified GHC.Arr as Arr
+import qualified GHC.Arr as ArrST
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(..) )
import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
#endif
-import Data.Dynamic
-#include "Dynamic.h"
+#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.Typeable
+#include "Typeable.h"
#include "MachDeps.h"
{-# RULES
"listArray/Array" listArray =
- \lu es -> runST (listArrayST lu es >>= GHC.Arr.unsafeFreezeSTArray)
+ \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)
#-}
{-# INLINE listUArrayST #-}
{-# INLINE (!) #-}
-- | Returns the element of an immutable array at the specified index.
(!) :: (IArray a e, Ix i) => a i e -> i -> e
-arr ! i | (l,u) <- bounds arr = unsafeAt arr (index (l,u) i)
+arr ! i = case bounds arr of (l,u) -> unsafeAt arr (index (l,u) i)
{-# INLINE indices #-}
-- | Returns a list of all the valid indices in an array.
indices :: (HasBounds a, Ix i) => a i e -> [i]
-indices arr | (l,u) <- bounds arr = range (l,u)
+indices arr = case bounds arr of (l,u) -> range (l,u)
{-# INLINE elems #-}
-- | Returns a list of all the elements of an array, in the same order
-- as their indices.
elems :: (IArray a e, Ix i) => a i e -> [e]
-elems arr | (l,u) <- bounds arr =
- [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
+elems arr = case bounds arr of
+ (l,u) -> [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
{-# INLINE assocs #-}
-- | Returns the contents of an array as a list of associations.
assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]
-assocs arr | (l,u) <- bounds arr =
- [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
+assocs arr = case bounds arr of
+ (l,u) -> [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
{-# INLINE accumArray #-}
this operation with complexity linear in the number of updates.
-}
(//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e
-arr // ies | (l,u) <- bounds arr =
- unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
+arr // ies = case bounds arr of
+ (l,u) -> unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE accum #-}
{-|
> accumArray f z b = accum f (array b [(i, z) | i \<- range b])
-}
accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e
-accum f arr ies | (l,u) <- bounds arr =
- unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
+accum f arr ies = case bounds arr of
+ (l,u) -> unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE amap #-}
-- | Returns a new array derived from the original array by applying a
-- function to each of the elements.
amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e
-amap f arr | (l,u) <- bounds arr =
- unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
+amap f arr = case bounds arr of
+ (l,u) -> unsafeArray (l,u) [(i, f (unsafeAt arr i)) |
+ i <- [0 .. rangeSize (l,u) - 1]]
{-# INLINE ixmap #-}
-- | Returns a new array derived from the original array by applying a
-- function to each of the indices.
-----------------------------------------------------------------------------
-- Normal polymorphic arrays
-instance HasBounds GHC.Arr.Array where
+instance HasBounds Arr.Array where
{-# INLINE bounds #-}
- bounds = GHC.Arr.bounds
+ bounds = Arr.bounds
-instance IArray GHC.Arr.Array e where
+instance IArray Arr.Array e where
{-# INLINE unsafeArray #-}
- unsafeArray = GHC.Arr.unsafeArray
+ unsafeArray = Arr.unsafeArray
{-# INLINE unsafeAt #-}
- unsafeAt = GHC.Arr.unsafeAt
+ unsafeAt = Arr.unsafeAt
{-# INLINE unsafeReplace #-}
- unsafeReplace = GHC.Arr.unsafeReplace
+ unsafeReplace = Arr.unsafeReplace
{-# INLINE unsafeAccum #-}
- unsafeAccum = GHC.Arr.unsafeAccum
+ unsafeAccum = Arr.unsafeAccum
{-# INLINE unsafeAccumArray #-}
- unsafeAccumArray = GHC.Arr.unsafeAccumArray
+ unsafeAccumArray = Arr.unsafeAccumArray
-----------------------------------------------------------------------------
-- 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)
-----------------------------------------------------------------------------
-- 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 #-}
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
+#ifdef __GLASGOW_HASKELL__
instance IArray UArray Word where
{-# INLINE unsafeArray #-}
- unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
+#endif
instance IArray UArray (Ptr a) where
{-# INLINE unsafeArray #-}
- 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 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 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 => 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, 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
{-# 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 | (l,u) <- bounds marr =
- unsafeRead marr (index (l,u) i)
+readArray marr i = case bounds marr of
+ (l,u) -> 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 | (l,u) <- bounds marr =
- unsafeWrite marr (index (l,u) i) e
+writeArray marr i e = case bounds marr of
+ (l,u) -> 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 | (l,u) <- bounds marr =
- sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
+getElems marr = case bounds marr of
+ (l,u) -> 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 | (l,u) <- bounds marr =
- sequence [do e <- unsafeRead marr (index (l,u) i); return (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)]
{-# 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 | (l,u) <- bounds marr = do
+mapArray f marr = case bounds marr of
+ (l,u) -> do
marr' <- newArray_ (l,u)
sequence_ [do
e <- unsafeRead marr i
instance HasBounds (STArray s) where
{-# INLINE bounds #-}
- bounds = GHC.Arr.boundsSTArray
+ bounds = ArrST.boundsSTArray
instance MArray (STArray s) e (ST s) where
{-# INLINE newArray #-}
- newArray = GHC.Arr.newSTArray
+ newArray = ArrST.newSTArray
{-# INLINE unsafeRead #-}
- unsafeRead = GHC.Arr.unsafeReadSTArray
+ unsafeRead = ArrST.unsafeReadSTArray
{-# INLINE unsafeWrite #-}
- unsafeWrite = GHC.Arr.unsafeWriteSTArray
+ unsafeWrite = ArrST.unsafeWriteSTArray
-----------------------------------------------------------------------------
-- Typeable instance for STArray
-- 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_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
where W# mask# = SIZEOF_HSWORD * 8 - 1
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) (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
-- 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 | (l,u) <- bounds marr = do
+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)
+#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# ->
(# s4#, UArray l u arr# #) }}}}
{-# RULES
-"freeze/STArray" freeze = GHC.Arr.freezeSTArray
+"freeze/STArray" freeze = ArrST.freezeSTArray
"freeze/STUArray" freeze = freezeSTUArray
#-}
+#endif /* __GLASGOW_HASKELL__ */
-- In-place conversion of mutable arrays to immutable 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
-- 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
{-# RULES
-"unsafeFreeze/STArray" unsafeFreeze = GHC.Arr.unsafeFreezeSTArray
+"unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray
"unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
#-}
-- mutable array (any instance of 'MArray') by taking a complete copy
-- of it.
thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
-thaw arr | (l,u) <- bounds arr = do
+thaw arr = case bounds arr of
+ (l,u) -> do
marr <- newArray_ (l,u)
sequence_ [unsafeWrite marr i (unsafeAt arr i)
| i <- [0 .. rangeSize (l,u) - 1]]
return marr
+#ifdef __GLASGOW_HASKELL__
thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
thawSTUArray (UArray l u arr#) = ST $ \s1# ->
case sizeofByteArray# arr# of { n# ->
memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
{-# RULES
-"thaw/STArray" thaw = GHC.Arr.thawSTArray
+"thaw/STArray" thaw = ArrST.thawSTArray
"thaw/STUArray" thaw = thawSTUArray
#-}
+#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).
-{-# INLINE unsafeThaw #-}
+{- |
+ 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 safe to use, therefore, if
+ the immutable version is never referenced again.
+
+ 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.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'
+
+ * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'
+
+ * 'Data.Array.Array' -> 'Data.Array.IO.IOArray'
--- | 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.
+ * 'Data.Array.Array' -> 'Data.Array.ST.STArray'
+-}
+{-# INLINE unsafeThaw #-}
unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
unsafeThaw = thaw
+#ifdef __GLASGOW_HASKELL__
{-# INLINE unsafeThawSTUArray #-}
unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
unsafeThawSTUArray (UArray l u marr#) =
return (STUArray l u (unsafeCoerce# marr#))
{-# RULES
-"unsafeThaw/STArray" unsafeThaw = GHC.Arr.unsafeThawSTArray
+"unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray
"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