From b9c2781e05a7cfb8098bbfa2d7946d8fadb9b0f1 Mon Sep 17 00:00:00 2001 From: ross Date: Mon, 12 May 2003 10:12:55 +0000 Subject: [PATCH] [project @ 2003-05-12 10:12:52 by ross] Hugs only (I hope): add unboxed arrays to Hugs --- Data/Array/Base.hs | 276 ++++++++++++++++++++++++++++++++++++++++++-- Data/Array/IO.hs | 18 +-- Data/Array/IO/Internals.hs | 27 +++-- Data/Array/ST.hs | 12 +- Data/PackedString.hs | 10 +- hugs/exclude | 2 - 6 files changed, 292 insertions(+), 53 deletions(-) diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index 6f150ab..f2d7ff7 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -19,6 +19,12 @@ module Data.Array.Base where import Prelude import Data.Ix ( Ix, range, index, rangeSize ) +import Data.Bits +import Data.Int +import Data.Word +import Foreign.Ptr +import Foreign.StablePtr +import Foreign.Storable #ifdef __GLASGOW_HASKELL__ import GHC.Arr ( STArray, unsafeIndex ) @@ -39,6 +45,7 @@ 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 @@ -172,7 +179,6 @@ listArrayST (l,u) es = do \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) @@ -232,7 +238,6 @@ listUArrayST (l,u) es = do "listArray/UArray/Word64" listArray = \lu (es :: [Word64]) -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray) #-} -#endif /* __GLASGOW_HASKELL__ */ {-# INLINE (!) #-} -- | Returns the element of an immutable array at the specified index. @@ -344,7 +349,6 @@ instance IArray Arr.Array e where {-# INLINE unsafeAccumArray #-} unsafeAccumArray = Arr.unsafeAccumArray -#ifdef __GLASGOW_HASKELL__ ----------------------------------------------------------------------------- -- Flat unboxed arrays @@ -364,7 +368,12 @@ instance IArray Arr.Array e where -- 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") @@ -380,11 +389,20 @@ unsafeArrayUArray (l,u) ies default_elem = do 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) @@ -441,7 +459,6 @@ cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) = other -> other {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-} -#endif /* __GLASGOW_HASKELL__ */ ----------------------------------------------------------------------------- -- Showing IArrays @@ -459,17 +476,27 @@ showsIArray p a = 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 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 #-} @@ -481,7 +508,12 @@ instance IArray UArray Char where {-# INLINE unsafeArray #-} 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 #-} @@ -492,8 +524,13 @@ instance IArray UArray Char where instance IArray UArray Int where {-# INLINE unsafeArray #-} 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 #-} @@ -501,6 +538,7 @@ instance IArray UArray Int where {-# INLINE unsafeAccumArray #-} unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies) +#ifdef __GLASGOW_HASKELL__ instance IArray UArray Word where {-# INLINE unsafeArray #-} unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) @@ -512,12 +550,18 @@ instance IArray UArray Word where 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 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 #-} @@ -528,8 +572,13 @@ instance IArray UArray (Ptr a) where instance IArray UArray (FunPtr a) where {-# INLINE unsafeArray #-} 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 #-} @@ -540,8 +589,13 @@ instance IArray UArray (FunPtr a) where instance IArray UArray Float where {-# INLINE unsafeArray #-} 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 #-} @@ -552,8 +606,13 @@ instance IArray UArray Float where instance IArray UArray Double where {-# INLINE unsafeArray #-} 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 #-} @@ -564,8 +623,13 @@ instance IArray UArray Double where instance IArray UArray (StablePtr a) where {-# INLINE unsafeArray #-} 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 #-} @@ -574,13 +638,23 @@ instance IArray UArray (StablePtr a) where 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 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 #-} @@ -591,8 +665,13 @@ instance IArray UArray Int8 where instance IArray UArray Int16 where {-# INLINE unsafeArray #-} 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 #-} @@ -603,8 +682,13 @@ instance IArray UArray Int16 where instance IArray UArray Int32 where {-# INLINE unsafeArray #-} 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 #-} @@ -615,8 +699,13 @@ instance IArray UArray Int32 where instance IArray UArray Int64 where {-# INLINE unsafeArray #-} 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 #-} @@ -627,8 +716,13 @@ instance IArray UArray Int64 where instance IArray UArray Word8 where {-# INLINE unsafeArray #-} 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 #-} @@ -639,8 +733,13 @@ instance IArray UArray Word8 where instance IArray UArray Word16 where {-# INLINE unsafeArray #-} 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 #-} @@ -651,8 +750,13 @@ instance IArray UArray Word16 where instance IArray UArray Word32 where {-# INLINE unsafeArray #-} 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 #-} @@ -663,8 +767,13 @@ instance IArray UArray Word32 where instance IArray UArray Word64 where {-# INLINE unsafeArray #-} 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 #-} @@ -681,8 +790,10 @@ instance Ix ix => Eq (UArray ix Char) where 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 @@ -696,8 +807,10 @@ instance Ix ix => Eq (UArray ix Float) where 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 @@ -732,8 +845,10 @@ instance Ix ix => Ord (UArray ix Char) where 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 @@ -780,8 +895,10 @@ instance (Ix ix, Show ix) => Show (UArray ix Char) where 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 @@ -812,7 +929,6 @@ instance (Ix ix, Show ix) => Show (UArray ix Word32) where instance (Ix ix, Show ix) => Show (UArray ix Word64) where showsPrec = showsIArray -#endif /* __GLASGOW_HASKELL__ */ ----------------------------------------------------------------------------- -- Mutable arrays @@ -957,7 +1073,6 @@ instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where typeOf ((undefined :: STArray a b c -> b) a), typeOf ((undefined :: STArray a b c -> c) a)] -#ifdef __GLASGOW_HASKELL__ ----------------------------------------------------------------------------- -- Flat unboxed mutable arrays (ST monad) @@ -976,7 +1091,12 @@ instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where -- 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") @@ -984,6 +1104,7 @@ 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 newArray #-} newArray (l,u) init = ST $ \s1# -> @@ -1282,6 +1403,126 @@ bOOL_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and# 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 @@ -1362,6 +1603,13 @@ foreign import ccall unsafe "memcpy" #-} #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 @@ -1388,3 +1636,17 @@ unsafeThawSTUArray (UArray l u marr#) = "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 diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs index bc82e2d..5e001d1 100644 --- a/Data/Array/IO.hs +++ b/Data/Array/IO.hs @@ -19,9 +19,7 @@ module Data.Array.IO ( -- * @IO@ arrays with unboxed elements IOUArray, -- instance of: Eq, Typeable -#ifdef __GLASGOW_HASKELL__ castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b) -#endif -- * Overloaded mutable array interface module Data.Array.MArray, @@ -47,7 +45,6 @@ import Foreign.C import Data.Array.Base import GHC.Arr -import GHC.ST ( ST(..) ) import GHC.IOBase import GHC.Handle #endif @@ -115,22 +112,11 @@ unsafeThawIOUArray arr = stToIO $ do "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray #-} -castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b) -castSTUArray (STUArray l u marr#) = return (STUArray l u marr#) - --- | Casts an 'IOUArray' 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...). -castIOUArray :: IOUArray ix a -> IO (IOUArray ix b) -castIOUArray (IOUArray marr) = stToIO $ do - marr' <- castSTUArray marr - return (IOUArray marr') - -- --------------------------------------------------------------------------- -- hGetArray -- | Reads a number of 'Word8's from the specified 'Handle' directly --- into an array. +-- into an array (GHC only). hGetArray :: Handle -- ^ Handle to read from -> IOUArray Int Word8 -- ^ Array in which to place the values @@ -185,7 +171,7 @@ readChunk fd is_stream ptr init_off bytes = loop init_off bytes -- --------------------------------------------------------------------------- -- hPutArray --- | Writes an array of 'Word8' to the specified 'Handle'. +-- | Writes an array of 'Word8' to the specified 'Handle' (GHC only). hPutArray :: Handle -- ^ Handle to write to -> IOUArray Int Word8 -- ^ Array to write from diff --git a/Data/Array/IO/Internals.hs b/Data/Array/IO/Internals.hs index 689333a..1479df3 100644 --- a/Data/Array/IO/Internals.hs +++ b/Data/Array/IO/Internals.hs @@ -16,6 +16,7 @@ module Data.Array.IO.Internals ( IOArray(..), -- instance of: Eq, Typeable IOUArray(..), -- instance of: Eq, Typeable + castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b) ) where import Prelude @@ -27,16 +28,14 @@ import Data.Dynamic #ifdef __HUGS__ import Hugs.IOArray -import Hugs.IOExts ( unsafeCoerce ) -import Data.Array.Storable #endif -#ifdef __GLASGOW_HASKELL__ +import Control.Monad.ST ( RealWorld, stToIO ) import Foreign.Ptr ( Ptr, FunPtr ) import Foreign.StablePtr ( StablePtr ) import Data.Array.Base -import GHC.Arr ( STArray ) +#ifdef __GLASGOW_HASKELL__ import GHC.IOBase import GHC.Base #endif /* __GLASGOW_HASKELL__ */ @@ -67,14 +66,6 @@ instance MArray IOArray e IO where unsafeRead = unsafeReadIOArray unsafeWrite = unsafeWriteIOArray - -#ifdef __HUGS__ -type IOUArray = StorableArray -#endif - -#ifdef __GLASGOW_HASKELL__ --- GHC only to the end of file - ----------------------------------------------------------------------------- -- Flat unboxed mutable arrays (IO monad) @@ -86,7 +77,7 @@ type IOUArray = StorableArray -- * @e@: the element type of the array. Only certain element types -- are supported: see 'MArray' for a list of instances. -- -newtype IOUArray i e = IOUArray (STUArray RealWorld i e) deriving Eq +newtype IOUArray i e = IOUArray (STUArray RealWorld i e) iOUArrayTc :: TyCon iOUArrayTc = mkTyCon "IOUArray" @@ -135,6 +126,7 @@ instance MArray IOUArray Int IO where {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) +#ifdef __GLASGOW_HASKELL__ instance MArray IOUArray Word IO where {-# INLINE newArray #-} newArray lu init = stToIO $ do @@ -146,6 +138,7 @@ instance MArray IOUArray Word IO where unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) +#endif instance MArray IOUArray (Ptr a) IO where {-# INLINE newArray #-} @@ -303,4 +296,10 @@ instance MArray IOUArray Word64 IO where {-# INLINE unsafeWrite #-} unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) -#endif /* __GLASGOW_HASKELL__ */ +-- | Casts an 'IOUArray' 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...). +castIOUArray :: IOUArray ix a -> IO (IOUArray ix b) +castIOUArray (IOUArray marr) = stToIO $ do + marr' <- castSTUArray marr + return (IOUArray marr') diff --git a/Data/Array/ST.hs b/Data/Array/ST.hs index cd81d83..0db90e1 100644 --- a/Data/Array/ST.hs +++ b/Data/Array/ST.hs @@ -17,11 +17,9 @@ module Data.Array.ST ( -- * Boxed arrays STArray, -- instance of: Eq, MArray -#ifdef __GLASGOW_HASKELL__ -- * Unboxed arrays STUArray, -- instance of: Eq, MArray castSTUArray, -- :: STUArray s i a -> ST s (STUArray s i b) -#endif -- * Overloaded mutable array interface module Data.Array.MArray, @@ -30,19 +28,13 @@ module Data.Array.ST ( import Prelude import Data.Array.MArray +import Data.Array.Base hiding (MArray(..)) + #ifdef __HUGS__ import Hugs.ST -#else -import Data.Array.Base hiding (MArray(..)) #endif #ifdef __GLASGOW_HASKELL__ import GHC.Arr import GHC.ST - --- | 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...). -castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b) -castSTUArray (STUArray l u marr#) = return (STUArray l u marr#) #endif diff --git a/Data/PackedString.hs b/Data/PackedString.hs index 51a66e9..6ab3e94 100644 --- a/Data/PackedString.hs +++ b/Data/PackedString.hs @@ -23,7 +23,7 @@ module Data.PackedString ( packString, -- :: String -> PackedString unpackPS, -- :: PackedString -> String -#ifndef __NHC__ +#ifdef __GLASGOW_HASKELL__ -- * I\/O with @PackedString@s hPutPS, -- :: Handle -> PackedString -> IO () hGetPS, -- :: Handle -> Int -> IO PackedString @@ -260,10 +260,11 @@ first_pos_that_satisfies pred ps len n = substrPS :: PackedString -> Int -> Int -> PackedString substrPS (PS ps) begin end = packString [ ps ! i | i <- [begin..end] ] +#ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- hPutPS --- | Outputs a 'PackedString' to the specified 'Handle'. +-- | Outputs a 'PackedString' to the specified 'Handle' (GHC only). -- -- NOTE: the representation of the 'PackedString' in the file is assumed to -- be in the ISO-8859-1 encoding. In other words, only the least signficant @@ -278,8 +279,8 @@ hPutPS h (PS ps) = do -- ----------------------------------------------------------------------------- -- hGetPS --- | Read a 'PackedString' directly from the specified 'Handle'. This --- is far more efficient than reading the characters into a 'String' +-- | Read a 'PackedString' directly from the specified 'Handle' (GHC only). +-- This is far more efficient than reading the characters into a 'String' -- and then using 'packString'. -- -- NOTE: as with 'hPutPS', the string representation in the file is @@ -290,6 +291,7 @@ hGetPS h i = do l <- hGetArray h arr i chars <- mapM (\i -> readArray arr i >>= return.chr.fromIntegral) [0..l-1] return (packString chars) +#endif /* __GLASGOW_HASKELL__ */ #else /* __NHC__ */ diff --git a/hugs/exclude b/hugs/exclude index d072a8e..4497642 100644 --- a/hugs/exclude +++ b/hugs/exclude @@ -2,8 +2,6 @@ # Only the first word on each line counts; the rest can be explanation. # Control.Parallel.Strategies unused by GHC too -Data.Array.Unboxed GHC-specific implementation Data.Generics GHC-specific -Data.PackedString uses Data.Array.Unboxed Debug.QuickCheck.Batch needs pre-emptive concurrency System.Posix.Signals -- 1.7.10.4