array 0.1.0.0 → 0.2.0.0
raw patch · 12 files changed
+343/−265 lines, 12 filesdep +sybnew-uploader
Dependencies added: syb
Files
- Data/Array.hs +13/−22
- Data/Array/Base.hs +127/−75
- Data/Array/Diff.hs +14/−7
- Data/Array/IArray.hs +0/−2
- Data/Array/IO.hs +8/−73
- Data/Array/IO/Internals.hs +74/−58
- Data/Array/MArray.hs +0/−2
- Data/Array/ST.hs +0/−2
- Data/Array/Storable.hs +3/−5
- Data/Array/Unboxed.hs +0/−2
- array.cabal +35/−17
- include/Typeable.h +69/−0
Data/Array.hs view
@@ -1,3 +1,4 @@+ ----------------------------------------------------------------------------- -- | -- Module : Data.Array @@ -10,7 +11,7 @@ -- -- Basic non-strict arrays. ----- /Note:/ The "Data.Array.IArray" module provides more general interface+-- /Note:/ The "Data.Array.IArray" module provides a more general interface -- to immutable arrays: it defines operations with the same names as -- those defined below, but with more general types, and also defines -- 'Array' instances of the relevant classes. To use that more general@@ -25,20 +26,16 @@ module Data.Ix -- export all of Ix , Array -- Array type is abstract - -- * Array construction , array -- :: (Ix a) => (a,a) -> [(a,b)] -> Array a b , listArray -- :: (Ix a) => (a,a) -> [b] -> Array a b , accumArray -- :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b- -- * Accessing arrays , (!) -- :: (Ix a) => Array a b -> a -> b , bounds -- :: (Ix a) => Array a b -> (a,a) , indices -- :: (Ix a) => Array a b -> [a] , elems -- :: (Ix a) => Array a b -> [b] , assocs -- :: (Ix a) => Array a b -> [(a,b)]- -- * Incremental array updates , (//) -- :: (Ix a) => Array a b -> [(a,b)] -> Array a b , accum -- :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b- -- * Derived arrays , ixmap -- :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a b -- Array instances:@@ -57,10 +54,9 @@ import Data.Ix #ifdef __GLASGOW_HASKELL__-import GHC.Arr -- Most of the hard work is done here-import Data.Generics.Basics -- To provide a Data instance-import Data.Generics.Instances -- To provide a Data instance-import GHC.Err ( error ) -- Needed for Data instance+import GHC.Arr -- Most of the hard work is done here+--import Data.Generics.Instances () -- To provide a Data instance+--import Data.Generics.Basics () -- because the Data instance is an orphan #endif #ifdef __HUGS__@@ -68,13 +64,11 @@ #endif #ifdef __NHC__-import Array -- Haskell'98 arrays-#else+import Array -- Haskell'98 arrays+#endif -import Control.Applicative-import Data.Foldable-import Data.Typeable-import Data.Traversable+-- For instances:+import Data.Typeable () {- $intro Haskell provides indexable /arrays/, which may be thought of as functions@@ -87,12 +81,9 @@ Since most array functions involve the class 'Ix', this module is exported from "Data.Array" so that modules need not import both "Data.Array" and "Data.Ix".--} -instance Ix i => Foldable (Array i) where- foldr f z = Prelude.foldr f z . elems--instance Ix i => Traversable (Array i) where- traverse f arr = listArray (bounds arr) <$> traverse f (elems arr)+Unfortunately, due to technical limitations, there are no docs here+currently, but you can find them in the @GHC.Arr@ module in the @base@+packages (which provides the actual implementations).+-} -#endif
Data/Array/Base.hs view
@@ -1,4 +1,11 @@-{-# OPTIONS_GHC -fno-bang-patterns #-}+{-# OPTIONS_GHC -XNoBangPatterns -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK hide #-}+-- XXX With a GHC 6.9 we get a spurious+-- Data/Array/Base.hs:26:0:+-- Warning: Module `Data.Ix' is imported, but nothing from it is used,+-- except perhaps instances visible in `Data.Ix'+-- To suppress this warning, use: import Data.Ix()+-- The -fno-warn-unused-imports works around that bug ----------------------------------------------------------------------------- -- |@@ -18,15 +25,10 @@ -- #hide module Data.Array.Base where -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 Data.Ix ( Ix, range, index, rangeSize ) import Foreign.C.Types-import Foreign.Ptr import Foreign.StablePtr #ifdef __GLASGOW_HASKELL__@@ -41,7 +43,12 @@ import GHC.Stable ( StablePtr(..) ) import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )-import GHC.IOBase ( IO(..) )+import GHC.IOBase ( IO(..), IOArray(..), stToIO,+ newIOArray, unsafeReadIOArray, unsafeWriteIOArray )+#else+import Data.Int+import Data.Word+import Foreign.Ptr #endif #ifdef __HUGS__@@ -50,6 +57,7 @@ import qualified Hugs.Array as Arr import qualified Hugs.ST as ArrST import Hugs.Array ( unsafeIndex )+import Hugs.IOArray import Hugs.ST ( STArray, ST(..), runST ) import Hugs.ByteArray #endif@@ -295,7 +303,7 @@ -- as their indices. elems :: (IArray a e, Ix i) => a i e -> [e] elems arr = case bounds arr of- (l,u) -> [unsafeAt arr i | i <- [0 .. numElements arr - 1]]+ (_l, _u) -> [unsafeAt arr i | i <- [0 .. numElements arr - 1]] {-# INLINE assocs #-} -- | Returns the contents of an array as a list of associations.@@ -324,9 +332,9 @@ -> (i,i) -- ^ The bounds of the array -> [(i, e')] -- ^ List of associations -> a i e -- ^ Returns: the array-accumArray f init (l,u) ies =+accumArray f initialValue (l,u) ies = let n = safeRangeSize (l, u)- in unsafeAccumArray f init (l,u)+ in unsafeAccumArray f initialValue (l,u) [(safeIndex (l,u) n i, e) | (i, e) <- ies] {-# INLINE (//) #-}@@ -436,16 +444,13 @@ 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)+#if __GLASGOW_HASKELL__ unsafeFreezeSTUArray (STUArray l u n marr#) = ST $ \s1# -> case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) -> (# s2#, UArray l u n arr# #) }-#endif--#ifdef __HUGS__-unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)+#elif __HUGS__ unsafeFreezeSTUArray (STUArray l u n marr) = do arr <- unsafeFreezeMutableByteArray marr return (UArray l u n arr)@@ -473,8 +478,8 @@ {-# INLINE unsafeAccumArrayUArray #-} unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)-unsafeAccumArrayUArray f init (l,u) ies = do- marr <- newArray (l,u) init+unsafeAccumArrayUArray f initialValue (l,u) ies = do+ marr <- newArray (l,u) initialValue sequence_ [do old <- unsafeRead marr i unsafeWrite marr i (f old new)@@ -553,7 +558,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Char where {-# INLINE bounds #-}@@ -574,7 +579,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Int where {-# INLINE bounds #-}@@ -595,7 +600,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Word where {-# INLINE bounds #-}@@ -616,7 +621,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray (Ptr a) where {-# INLINE bounds #-}@@ -637,7 +642,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray (FunPtr a) where {-# INLINE bounds #-}@@ -658,7 +663,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Float where {-# INLINE bounds #-}@@ -679,7 +684,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Double where {-# INLINE bounds #-}@@ -700,7 +705,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray (StablePtr a) where {-# INLINE bounds #-}@@ -721,9 +726,10 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) -- bogus StablePtr value for initialising a UArray of StablePtr.+nullStablePtr :: StablePtr a #ifdef __GLASGOW_HASKELL__ nullStablePtr = StablePtr (unsafeCoerce# 0#) #endif@@ -750,7 +756,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Int16 where {-# INLINE bounds #-}@@ -771,7 +777,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Int32 where {-# INLINE bounds #-}@@ -792,7 +798,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Int64 where {-# INLINE bounds #-}@@ -813,7 +819,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Word8 where {-# INLINE bounds #-}@@ -834,7 +840,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Word16 where {-# INLINE bounds #-}@@ -855,7 +861,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Word32 where {-# INLINE bounds #-}@@ -876,7 +882,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance IArray UArray Word64 where {-# INLINE bounds #-}@@ -897,7 +903,7 @@ {-# INLINE unsafeAccum #-} unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) {-# INLINE unsafeAccumArray #-}- unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)+ unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where (==) = eqUArray@@ -954,10 +960,10 @@ -- 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+ newArray (l,u) initialValue = do let n = safeRangeSize (l,u) marr <- unsafeNewArray_ (l,u)- sequence_ [unsafeWrite marr i init | i <- [0 .. n - 1]]+ sequence_ [unsafeWrite marr i initialValue | i <- [0 .. n - 1]] return marr {-# INLINE unsafeNewArray_ #-}@@ -981,6 +987,20 @@ -- default initialisation with undefined values if we *do* know the -- initial value and it is constant for all elements. +instance MArray IOArray e IO where+#if defined(__HUGS__)+ getBounds = return . boundsIOArray+ getNumElements = return . getNumElementsIOArray+#elif defined(__GLASGOW_HASKELL__)+ {-# INLINE getBounds #-}+ getBounds (IOArray marr) = stToIO $ getBounds marr+ {-# INLINE getNumElements #-}+ getNumElements (IOArray marr) = stToIO $ getNumElements marr+#endif+ newArray = newIOArray+ unsafeRead = unsafeReadIOArray+ unsafeWrite = unsafeWriteIOArray+ {-# INLINE newListArray #-} -- | Constructs a mutable array from a list of initial elements. -- The list gives the elements of the array in ascending order@@ -1016,7 +1036,7 @@ -- | 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 = do - (l,u) <- getBounds marr+ (_l, _u) <- getBounds marr n <- getNumElements marr sequence [unsafeRead marr i | i <- [0 .. n - 1]] @@ -1107,17 +1127,23 @@ -- don\'t use 'STUArray' if you require the non-strictness that -- 'STArray' provides. #ifdef __GLASGOW_HASKELL__-data STUArray s i a = STUArray !i !i !Int (MutableByteArray# s)+data STUArray s i e = STUArray !i !i !Int (MutableByteArray# s) #endif #ifdef __HUGS__-data STUArray s i a = STUArray !i !i !Int !(MutableByteArray s)+data STUArray s i e = STUArray !i !i !Int !(MutableByteArray s) #endif INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray") +#ifdef __GLASGOW_HASKELL__ instance Eq (STUArray s i e) where STUArray _ _ _ arr1# == STUArray _ _ _ arr2# = sameMutableByteArray# arr1# arr2#+#endif+#ifdef __HUGS__+instance Eq (STUArray s i e) where+ STUArray _ _ _ arr1 == STUArray _ _ _ arr2 = arr1 == arr2+#endif #ifdef __GLASGOW_HASKELL__ {-# INLINE unsafeNewArraySTUArray_ #-}@@ -1137,7 +1163,7 @@ {-# INLINE getNumElements #-} getNumElements (STUArray _ _ n _) = return n {-# INLINE newArray #-}- newArray (l,u) init = ST $ \s1# ->+ newArray (l,u) initialValue = ST $ \s1# -> case safeRangeSize (l,u) of { n@(I# n#) -> case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) -> case bOOL_WORD_SCALE n# of { n'# ->@@ -1148,11 +1174,11 @@ case loop 0# s2# of { s3# -> (# s3#, STUArray l u n marr# #) }}}} where- W# e# = if init then maxBound else 0+ W# e# = if initialValue then maxBound else 0 {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds False+ newArray_ arrBounds = newArray arrBounds False {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->@@ -1174,7 +1200,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds (chr 0)+ newArray_ arrBounds = newArray arrBounds (chr 0) {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1192,7 +1218,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readIntArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1210,7 +1236,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWordArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1228,7 +1254,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds nullPtr+ newArray_ arrBounds = newArray arrBounds nullPtr {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1246,7 +1272,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds nullFunPtr+ newArray_ arrBounds = newArray arrBounds nullFunPtr {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1264,7 +1290,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) fLOAT_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1282,7 +1308,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) dOUBLE_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1300,7 +1326,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds (castPtrToStablePtr nullPtr)+ newArray_ arrBounds = newArray arrBounds (castPtrToStablePtr nullPtr) {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->@@ -1318,7 +1344,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1336,7 +1362,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 2#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1354,7 +1380,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1372,7 +1398,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 8#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1390,7 +1416,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1408,7 +1434,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 2#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1426,7 +1452,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1444,7 +1470,7 @@ {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 8#) {-# INLINE newArray_ #-}- newArray_ bounds = newArray bounds 0+ newArray_ arrBounds = newArray arrBounds 0 {-# INLINE unsafeRead #-} unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->@@ -1674,12 +1700,10 @@ freeze marr = do (l,u) <- getBounds marr n <- getNumElements marr- ies <- sequence [do e <- unsafeRead marr i; return (i,e)- | i <- [0 .. n - 1]]- -- The old array may be lying about the number of elements in- -- (l,u), so recalculate it to be safe.- let n' = safeRangeSize (l,u)- return (unsafeArray (l,u) ies)+ es <- mapM (unsafeRead marr) [0 .. n - 1]+ -- The old array and index might not be well-behaved, so we need to+ -- use the safe array creation function here.+ return (listArray (l,u) es) #ifdef __GLASGOW_HASKELL__ freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)@@ -1757,8 +1781,8 @@ | i <- [0 .. n - 1]] return marr -#ifdef __GLASGOW_HASKELL__ thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)+#if __GLASGOW_HASKELL__ thawSTUArray (UArray l u n arr#) = ST $ \s1# -> case sizeofByteArray# arr# of { n# -> case newByteArray# n# s1# of { (# s2#, marr# #) ->@@ -1774,10 +1798,7 @@ "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)+#elif __HUGS__ thawSTUArray (UArray l u n arr) = do marr <- thawByteArray arr return (STUArray l u n marr)@@ -1835,18 +1856,49 @@ "unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray #-}++{-# INLINE unsafeThawIOArray #-}+unsafeThawIOArray :: Ix ix => Arr.Array ix e -> IO (IOArray ix e)+unsafeThawIOArray arr = stToIO $ do+ marr <- ArrST.unsafeThawSTArray arr+ return (IOArray marr)++{-# RULES+"unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray+ #-}++thawIOArray :: Ix ix => Arr.Array ix e -> IO (IOArray ix e)+thawIOArray arr = stToIO $ do+ marr <- ArrST.thawSTArray arr+ return (IOArray marr)++{-# RULES+"thaw/IOArray" thaw = thawIOArray+ #-}++freezeIOArray :: Ix ix => IOArray ix e -> IO (Arr.Array ix e)+freezeIOArray (IOArray marr) = stToIO (ArrST.freezeSTArray marr)++{-# RULES+"freeze/IOArray" freeze = freezeIOArray+ #-}++{-# INLINE unsafeFreezeIOArray #-}+unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Arr.Array ix e)+unsafeFreezeIOArray (IOArray marr) = stToIO (ArrST.unsafeFreezeSTArray marr)++{-# RULES+"unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray+ #-} #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)+#if __GLASGOW_HASKELL__ castSTUArray (STUArray l u n marr#) = return (STUArray l u n marr#)-#endif--#ifdef __HUGS__-castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)+#elif __HUGS__ castSTUArray (STUArray l u n marr) = return (STUArray l u n marr) #endif
Data/Array/Diff.hs view
@@ -73,9 +73,6 @@ ------------------------------------------------------------------------ -- Imports. -import Prelude--import Data.Ix import Data.Array.Base import Data.Array.IArray import Data.Array.IO@@ -85,7 +82,7 @@ import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word, Word8, Word16, Word32, Word64 ) -import System.IO.Unsafe ( unsafePerformIO )+import System.IO.Unsafe ( unsafePerformIO ) import Control.Exception ( evaluate ) import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar ) @@ -111,7 +108,7 @@ type DiffUArray = IOToDiffArray IOUArray -- Having 'MArray a e IO' in instance context would require--- -fallow-undecidable-instances, so each instance is separate here.+-- -XUndecidableInstances, so each instance is separate here. ------------------------------------------------------------------------ -- Showing DiffArrays@@ -119,6 +116,9 @@ instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where showsPrec = showsIArray +instance (Ix ix, Show ix) => Show (DiffUArray ix Bool) where+ showsPrec = showsIArray+ instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where showsPrec = showsIArray @@ -168,6 +168,13 @@ unsafeAt a i = unsafePerformIO $ a `readDiffArray` i unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray1` ies +instance IArray (IOToDiffArray IOUArray) Bool where+ bounds a = unsafePerformIO $ boundsDiffArray a+ numElements a = unsafePerformIO $ numElementsDiffArray a+ unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies+ unsafeAt a i = unsafePerformIO $ a `readDiffArray` i+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies+ instance IArray (IOToDiffArray IOUArray) Char where bounds a = unsafePerformIO $ boundsDiffArray a numElements a = unsafePerformIO $ numElementsDiffArray a@@ -356,9 +363,9 @@ => IOToDiffArray a i e -> [(Int, e)] -> IO (IOToDiffArray a i e)-a `replaceDiffArray2` ies = do+arr `replaceDiffArray2` ies = do mapM_ (\(a,b) -> do evaluate a; evaluate b) ies- a `replaceDiffArray` ies+ arr `replaceDiffArray` ies boundsDiffArray :: (MArray a e IO, Ix ix)
Data/Array/IArray.hs view
@@ -44,8 +44,6 @@ ixmap, -- :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e ) where -import Prelude- import Data.Ix import Data.Array (Array) import Data.Array.Base
Data/Array/IO.hs view
@@ -29,91 +29,26 @@ hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO () ) where -import Prelude- import Data.Array.Base import Data.Array.IO.Internals-import Data.Array ( Array ) import Data.Array.MArray-import Data.Int-import Data.Word #ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C import GHC.Arr+ import GHC.IOBase import GHC.Handle #else import Data.Char+import Data.Word ( Word8 ) import System.IO import System.IO.Error #endif #ifdef __GLASGOW_HASKELL__--------------------------------------------------------------------------------- Freezing--freezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)-freezeIOArray (IOArray marr) = stToIO (freezeSTArray marr)--freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)-freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)--{-# RULES-"freeze/IOArray" freeze = freezeIOArray-"freeze/IOUArray" freeze = freezeIOUArray- #-}--{-# INLINE unsafeFreezeIOArray #-}-unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Array ix e)-unsafeFreezeIOArray (IOArray marr) = stToIO (unsafeFreezeSTArray marr)--{-# INLINE unsafeFreezeIOUArray #-}-unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)-unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)--{-# RULES-"unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray-"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray- #-}---------------------------------------------------------------------------------- Thawing--thawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)-thawIOArray arr = stToIO $ do- marr <- thawSTArray arr- return (IOArray marr)--thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)-thawIOUArray arr = stToIO $ do- marr <- thawSTUArray arr- return (IOUArray marr)--{-# RULES-"thaw/IOArray" thaw = thawIOArray-"thaw/IOUArray" thaw = thawIOUArray- #-}--{-# INLINE unsafeThawIOArray #-}-unsafeThawIOArray :: Ix ix => Array ix e -> IO (IOArray ix e)-unsafeThawIOArray arr = stToIO $ do- marr <- unsafeThawSTArray arr- return (IOArray marr)--{-# INLINE unsafeThawIOUArray #-}-unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)-unsafeThawIOUArray arr = stToIO $ do- marr <- unsafeThawSTUArray arr- return (IOUArray marr)--{-# RULES-"unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray-"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray- #-}- -- --------------------------------------------------------------------------- -- hGetArray @@ -128,14 +63,14 @@ -- read, which might be smaller than the number requested -- if the end of file was reached. -hGetArray handle (IOUArray (STUArray l u n ptr)) count+hGetArray handle (IOUArray (STUArray _l _u n ptr)) count | count == 0 = return 0 | count < 0 || count > n = illegalBufferSize handle "hGetArray" count | otherwise = do wantReadableHandle "hGetArray" handle $ - \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do+ \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref if bufferEmpty buf then readChunk fd is_stream ptr 0 count@@ -158,7 +93,7 @@ else return count readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int-readChunk fd is_stream ptr init_off bytes = loop init_off bytes +readChunk fd is_stream ptr init_off bytes0 = loop init_off bytes0 where loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return (off - init_off)@@ -180,16 +115,16 @@ -> Int -- ^ Number of 'Word8's to write -> IO () -hPutArray handle (IOUArray (STUArray l u n raw)) count+hPutArray handle (IOUArray (STUArray _l _u n raw)) count | count == 0 = return () | count < 0 || count > n = illegalBufferSize handle "hPutArray" count | otherwise = do wantWritableHandle "hPutArray" handle $ - \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do+ \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do - old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }+ old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size } <- readIORef ref -- enough room in handle buffer?
Data/Array/IO/Internals.hs view
@@ -18,11 +18,11 @@ IOArray(..), -- instance of: Eq, Typeable IOUArray(..), -- instance of: Eq, Typeable castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b)+#ifdef __GLASGOW_HASKELL__+ unsafeThawIOUArray,+#endif ) where -import Prelude--import Data.Array.MArray import Data.Int import Data.Word import Data.Typeable@@ -35,34 +35,15 @@ import Foreign.Ptr ( Ptr, FunPtr ) import Foreign.StablePtr ( StablePtr ) import Data.Array.Base+import Data.Ix #ifdef __GLASGOW_HASKELL__-import GHC.IOBase-import GHC.Base+import GHC.IOBase (IOArray(..)) #endif /* __GLASGOW_HASKELL__ */ #include "Typeable.h" -INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")- -------------------------------------------------------------------------------- | Instance declarations for 'IOArray's--instance MArray IOArray e IO where-#if defined(__HUGS__)- getBounds = return . boundsIOArray- getNumElements = return . getNumElementsIOArray-#elif defined(__GLASGOW_HASKELL__)- {-# INLINE getBounds #-}- getBounds (IOArray marr) = stToIO $ getBounds marr- {-# INLINE getNumElements #-}- getNumElements (IOArray marr) = stToIO $ getNumElements marr-#endif- newArray = newIOArray- unsafeRead = unsafeReadIOArray- unsafeWrite = unsafeWriteIOArray------------------------------------------------------------------------------- -- Flat unboxed mutable arrays (IO monad) -- | Mutable, unboxed, strict arrays in the 'IO' monad. The type@@ -86,8 +67,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -104,8 +85,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -122,8 +103,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -140,8 +121,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -158,8 +139,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -176,8 +157,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -194,8 +175,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -212,8 +193,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -230,8 +211,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -248,8 +229,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -266,8 +247,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -284,8 +265,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -302,8 +283,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -320,8 +301,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -338,8 +319,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -356,8 +337,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -374,8 +355,8 @@ {-# INLINE getNumElements #-} getNumElements (IOUArray arr) = stToIO $ getNumElements arr {-# INLINE newArray #-}- newArray lu init = stToIO $ do- marr <- newArray lu init; return (IOUArray marr)+ newArray lu initialValue = stToIO $ do+ marr <- newArray lu initialValue; return (IOUArray marr) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ lu = stToIO $ do marr <- unsafeNewArray_ lu; return (IOUArray marr)@@ -394,3 +375,38 @@ marr' <- castSTUArray marr return (IOUArray marr') +#ifdef __GLASGOW_HASKELL__+{-# INLINE unsafeThawIOUArray #-}+unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)+unsafeThawIOUArray arr = stToIO $ do+ marr <- unsafeThawSTUArray arr+ return (IOUArray marr)++{-# RULES+"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray+ #-}++thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)+thawIOUArray arr = stToIO $ do+ marr <- thawSTUArray arr+ return (IOUArray marr)++{-# RULES+"thaw/IOUArray" thaw = thawIOUArray+ #-}++{-# INLINE unsafeFreezeIOUArray #-}+unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)+unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)++{-# RULES+"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray+ #-}++freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)+freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)++{-# RULES+"freeze/IOUArray" freeze = freezeIOUArray+ #-}+#endif /* __GLASGOW_HASKELL__ */
Data/Array/MArray.hs view
@@ -46,8 +46,6 @@ unsafeThaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) ) where -import Prelude- import Data.Ix #ifdef __HADDOCK__ import Data.Array.IArray
Data/Array/ST.hs view
@@ -27,8 +27,6 @@ module Data.Array.MArray, ) where -import Prelude- import Data.Array.MArray import Data.Array.Base ( STUArray, castSTUArray, UArray, unsafeFreezeSTUArray ) import Control.Monad.ST ( ST, runST )
Data/Array/Storable.hs view
@@ -40,8 +40,6 @@ ) where -import Prelude- import Data.Array.Base import Data.Array.MArray import Foreign hiding (newArray)@@ -52,12 +50,12 @@ instance Storable e => MArray StorableArray e IO where getBounds (StorableArray l u _ _) = return (l,u) - getNumElements (StorableArray l u n _) = return n+ getNumElements (StorableArray _l _u n _) = return n - newArray (l,u) init = do+ newArray (l,u) initialValue = do fp <- mallocForeignPtrArray size withForeignPtr fp $ \a ->- sequence_ [pokeElemOff a i init | i <- [0..size-1]]+ sequence_ [pokeElemOff a i initialValue | i <- [0..size-1]] return (StorableArray l u size fp) where size = rangeSize (l,u)
Data/Array/Unboxed.hs view
@@ -20,7 +20,5 @@ module Data.Array.IArray, ) where -import Prelude- import Data.Array.IArray import Data.Array.Base
array.cabal view
@@ -1,28 +1,46 @@ name: array-version: 0.1.0.0+version: 0.2.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: Mutable and immutable arrays+category: Data Structures description: This package defines the classes @IArray@ of immutable arrays and @MArray@ of arrays mutable within appropriate monads, as well as some instances of these classes.+cabal-version: >=1.2 build-type: Simple-build-depends: base-exposed-modules:- Data.Array- Data.Array.Base- Data.Array.Diff- Data.Array.IArray- Data.Array.IO- Data.Array.MArray- Data.Array.ST- Data.Array.Storable- Data.Array.Unboxed-other-modules:- Data.Array.IO.Internals-extensions: CPP-include-dirs: include-ghc-options: -fglasgow-exts+extra-source-files: include/Typeable.h +library+ build-depends: base+ if !impl(nhc98)+ build-depends: syb+ exposed-modules:+ Data.Array+ extensions: CPP+ if !impl(nhc98)+ exposed-modules:+ Data.Array.Base+ Data.Array.Diff+ Data.Array.IArray+ Data.Array.IO+ Data.Array.IO.Internals+ Data.Array.MArray+ Data.Array.ST+ Data.Array.Storable+ Data.Array.Unboxed+ extensions:+ MultiParamTypeClasses,+ FlexibleContexts,+ FlexibleInstances,+ TypeSynonymInstances+ if impl(ghc)+ extensions:+ Rank2Types,+ MagicHash,+ UnboxedTuples,+ ForeignFunctionInterface,+ UnliftedFFITypes+ include-dirs: include
+ include/Typeable.h view
@@ -0,0 +1,69 @@+{- --------------------------------------------------------------------------+// Macros to help make Typeable instances.+//+// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines+//+// instance Typeable/n/ tc+// instance Typeable a => Typeable/n-1/ (tc a)+// instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)+// ...+// instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)+// --------------------------------------------------------------------------+-}++#ifndef TYPEABLE_H+#define TYPEABLE_H++#define INSTANCE_TYPEABLE0(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }++#ifdef __GLASGOW_HASKELL__++-- // For GHC, the extra instances follow from general instance declarations+-- // defined in Data.Typeable.++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }++#else /* !__GLASGOW_HASKELL__ */++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable1 (tycon a) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \+ typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable2 (tycon a) where { \+ typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \+ typeOf = typeOfDefault }++#endif /* !__GLASGOW_HASKELL__ */++#endif