array 0.2.0.0 → 0.3.0.0
raw patch · 7 files changed
+82/−563 lines, 7 filesdep −sybdep ~base
Dependencies removed: syb
Dependency ranges changed: base
Files
- Data/Array.hs +4/−6
- Data/Array/Base.hs +33/−18
- Data/Array/Diff.hs +0/−456
- Data/Array/IArray.hs +2/−1
- Data/Array/IO.hs +31/−76
- Data/Array/IO/Internals.hs +4/−0
- array.cabal +8/−6
Data/Array.hs view
@@ -26,16 +26,20 @@ 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:@@ -55,8 +59,6 @@ #ifdef __GLASGOW_HASKELL__ 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__@@ -81,9 +83,5 @@ 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".--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). -}
Data/Array/Base.hs view
@@ -43,8 +43,14 @@ import GHC.Stable ( StablePtr(..) ) import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )+#if __GLASGOW_HASKELL__ >= 611+import GHC.IO ( IO(..), stToIO )+import GHC.IOArray ( IOArray(..),+ newIOArray, unsafeReadIOArray, unsafeWriteIOArray )+#else import GHC.IOBase ( IO(..), IOArray(..), stToIO, newIOArray, unsafeReadIOArray, unsafeWriteIOArray )+#endif #else import Data.Int import Data.Word@@ -102,10 +108,11 @@ {-# INLINE safeIndex #-} safeIndex :: Ix i => (i, i) -> Int -> i -> Int-safeIndex (l,u) n i = let i' = unsafeIndex (l,u) i+safeIndex (l,u) n i = let i' = index (l,u) i in if (0 <= i') && (i' < n) then i'- else error "Error in array index"+ else error ("Error in array index; " ++ show i' +++ " not in range [0.." ++ show n ++ ")") {-# INLINE unsafeReplaceST #-} unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)@@ -352,8 +359,8 @@ 98 requires that for 'Array' the value at such indices is bottom.) For most array types, this operation is O(/n/) where /n/ is the size-of the array. However, the 'Data.Array.Diff.DiffArray' type provides-this operation with complexity linear in the number of updates.+of the array. However, the diffarray package provides an array type+for which this operation has complexity linear in the number of updates. -} (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e arr // ies = case bounds arr of@@ -956,15 +963,11 @@ unsafeRead :: Ix i => a i e -> Int -> m e unsafeWrite :: Ix i => a i e -> Int -> e -> m () - {-# INLINE newArray #-}+ {- INLINE newArray #-} -- The INLINE is crucial, because until we know at least which monad -- we are in, the code below allocates like crazy. So inline it, -- in the hope that the context will know the monad.- newArray (l,u) initialValue = do- let n = safeRangeSize (l,u)- marr <- unsafeNewArray_ (l,u)- sequence_ [unsafeWrite marr i initialValue | i <- [0 .. n - 1]]- return marr+ newArray = newArrayImpl {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom@@ -987,6 +990,17 @@ -- default initialisation with undefined values if we *do* know the -- initial value and it is constant for all elements. +-- Workaround for performance bug #3586, GHC 6.12 only (not 6.13 and+-- later, which fixed the underlying problem).+{-# INLINE newArrayImpl #-}+newArrayImpl :: (Ix i, MArray a e m) => (i, i) -> e -> m (a i e)+newArrayImpl (l,u) initialValue = do+ let n = safeRangeSize (l,u)+ marr <- unsafeNewArray_ (l,u)+ sequence_ [unsafeWrite marr i initialValue | i <- [0 .. n - 1]]+ return marr++ instance MArray IOArray e IO where #if defined(__HUGS__) getBounds = return . boundsIOArray@@ -1174,7 +1188,7 @@ case loop 0# s2# of { s3# -> (# s3#, STUArray l u n marr# #) }}}} where- W# e# = if initialValue then maxBound else 0+ !(W# e#) = if initialValue then maxBound else 0 {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE {-# INLINE newArray_ #-}@@ -1486,12 +1500,12 @@ bOOL_SCALE, bOOL_WORD_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int# bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#- where I# last# = SIZEOF_HSWORD * 8 - 1+ where !(I# last#) = SIZEOF_HSWORD * 8 - 1 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)- where I# last# = SIZEOF_HSWORD * 8 - 1-wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSWORD-dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE-fLOAT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT+ where !(I# last#) = SIZEOF_HSWORD * 8 - 1+wORD_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_HSWORD+dOUBLE_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_HSDOUBLE+fLOAT_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_HSFLOAT bOOL_INDEX :: Int# -> Int# #if SIZEOF_HSWORD == 4@@ -1502,8 +1516,9 @@ bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word# 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+ 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__
− Data/Array/Diff.hs
@@ -1,456 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Data.Array.Diff--- Copyright : (c) The University of Glasgow 2001--- License : BSD-style (see the file libraries/base/LICENSE)--- --- Maintainer : libraries@haskell.org--- Stability : experimental--- Portability : non-portable (uses Data.Array.IArray)------ Functional arrays with constant-time update.-----------------------------------------------------------------------------------module Data.Array.Diff (-- -- * Diff array types-- -- | Diff arrays have an immutable interface, but rely on internal- -- updates in place to provide fast functional update operator- -- '//'.- --- -- When the '//' operator is applied to a diff array, its contents- -- are physically updated in place. The old array silently changes- -- its representation without changing the visible behavior:- -- it stores a link to the new current array along with the- -- difference to be applied to get the old contents.- --- -- So if a diff array is used in a single-threaded style,- -- i.e. after '//' application the old version is no longer used,- -- @a'!'i@ takes O(1) time and @a '//' d@ takes O(@length d@).- -- Accessing elements of older versions gradually becomes slower.- --- -- Updating an array which is not current makes a physical copy.- -- The resulting array is unlinked from the old family. So you- -- can obtain a version which is guaranteed to be current and- -- thus have fast element access by @a '//' []@.-- -- Possible improvement for the future (not implemented now):- -- make it possible to say "I will make an update now, but when- -- I later return to the old version, I want it to mutate back- -- instead of being copied".-- IOToDiffArray, -- data IOToDiffArray- -- (a :: * -> * -> *) -- internal mutable array- -- (i :: *) -- indices- -- (e :: *) -- elements-- -- | Type synonyms for the two most important IO array types.-- -- Two most important diff array types are fully polymorphic- -- lazy boxed DiffArray:- DiffArray, -- = IOToDiffArray IOArray- -- ...and strict unboxed DiffUArray, working only for elements- -- of primitive types but more compact and usually faster:- DiffUArray, -- = IOToDiffArray IOUArray-- -- * Overloaded immutable array interface- - -- | Module "Data.Array.IArray" provides the interface of diff arrays.- -- They are instances of class 'IArray'.- module Data.Array.IArray,-- -- * Low-level interface-- -- | These are really internal functions, but you will need them- -- to make further 'IArray' instances of various diff array types- -- (for either more 'MArray' types or more unboxed element types).- newDiffArray, readDiffArray, replaceDiffArray- )- where----------------------------------------------------------------------------- Imports.--import Data.Array.Base-import Data.Array.IArray-import Data.Array.IO--import Foreign.Ptr ( Ptr, FunPtr )-import Foreign.StablePtr ( StablePtr )-import Data.Int ( Int8, Int16, Int32, Int64 )-import Data.Word ( Word, Word8, Word16, Word32, Word64 )--import System.IO.Unsafe ( unsafePerformIO )-import Control.Exception ( evaluate )-import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )----------------------------------------------------------------------------- Diff array types.---- | An arbitrary 'MArray' type living in the 'IO' monad can be converted--- to a diff array.--newtype IOToDiffArray a i e =- DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}---- Internal representation: either a mutable array, or a link to--- another diff array patched with a list of index+element pairs.-data DiffArrayData a i e = Current (a i e)- | Diff (IOToDiffArray a i e) [(Int, e)]---- | Fully polymorphic lazy boxed diff array.-type DiffArray = IOToDiffArray IOArray---- | Strict unboxed diff array, working only for elements--- of primitive types but more compact and usually faster than 'DiffArray'.-type DiffUArray = IOToDiffArray IOUArray---- Having 'MArray a e IO' in instance context would require--- -XUndecidableInstances, so each instance is separate here.----------------------------------------------------------------------------- Showing DiffArrays--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--instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where- showsPrec = showsIArray--instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where- showsPrec = showsIArray----------------------------------------------------------------------------- Boring instances.--instance IArray (IOToDiffArray IOArray) e 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 `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- 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) Int 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) Word 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) (Ptr a) 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) (FunPtr a) 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) Float 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) Double 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) (StablePtr a) 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) Int8 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) Int16 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) Int32 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) Int64 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) Word8 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) Word16 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) Word32 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) Word64 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------------------------------------------------------------------------------- The important stuff.--newDiffArray :: (MArray a e IO, Ix i)- => (i,i)- -> [(Int, e)]- -> IO (IOToDiffArray a i e)-newDiffArray (l,u) ies = do- a <- newArray_ (l,u)- sequence_ [unsafeWrite a i e | (i, e) <- ies]- var <- newMVar (Current a)- return (DiffArray var)--readDiffArray :: (MArray a e IO, Ix i)- => IOToDiffArray a i e- -> Int- -> IO e-a `readDiffArray` i = do- d <- readMVar (varDiffArray a)- case d of- Current a' -> unsafeRead a' i- Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)--replaceDiffArray :: (MArray a e IO, Ix i)- => IOToDiffArray a i e- -> [(Int, e)]- -> IO (IOToDiffArray a i e)-a `replaceDiffArray` ies = do- d <- takeMVar (varDiffArray a)- case d of- Current a' -> case ies of- [] -> do- -- We don't do the copy when there is nothing to change- -- and this is the current version. But see below.- putMVar (varDiffArray a) d- return a- _:_ -> do- diff <- sequence [do e <- unsafeRead a' i; return (i, e)- | (i, _) <- ies]- sequence_ [unsafeWrite a' i e | (i, e) <- ies]- var' <- newMVar (Current a')- putMVar (varDiffArray a) (Diff (DiffArray var') diff)- return (DiffArray var')- Diff _ _ -> do- -- We still do the copy when there is nothing to change- -- but this is not the current version. So you can use- -- 'a // []' to make sure that the resulting array has- -- fast element access.- putMVar (varDiffArray a) d- a' <- thawDiffArray a- -- thawDiffArray gives a fresh array which we can- -- safely mutate.- sequence_ [unsafeWrite a' i e | (i, e) <- ies]- var' <- newMVar (Current a')- return (DiffArray var')---- The elements of the diff list might recursively reference the--- array, so we must seq them before taking the MVar to avoid--- deadlock.-replaceDiffArray1 :: (MArray a e IO, Ix i)- => IOToDiffArray a i e- -> [(Int, e)]- -> IO (IOToDiffArray a i e)-a `replaceDiffArray1` ies = do- mapM_ (evaluate . fst) ies- a `replaceDiffArray` ies---- If the array contains unboxed elements, then the elements of the--- diff list may also recursively reference the array from inside--- replaceDiffArray, so we must seq them too.-replaceDiffArray2 :: (MArray a e IO, Ix i)- => IOToDiffArray a i e- -> [(Int, e)]- -> IO (IOToDiffArray a i e)-arr `replaceDiffArray2` ies = do- mapM_ (\(a,b) -> do evaluate a; evaluate b) ies- arr `replaceDiffArray` ies---boundsDiffArray :: (MArray a e IO, Ix ix)- => IOToDiffArray a ix e- -> IO (ix,ix)-boundsDiffArray a = do- d <- readMVar (varDiffArray a)- case d of- Current a' -> getBounds a'- Diff a' _ -> boundsDiffArray a'--numElementsDiffArray :: (MArray a e IO, Ix ix)- => IOToDiffArray a ix e- -> IO Int-numElementsDiffArray a- = do d <- readMVar (varDiffArray a)- case d of- Current a' -> getNumElements a'- Diff a' _ -> numElementsDiffArray a'--freezeDiffArray :: (MArray a e IO, Ix ix)- => a ix e- -> IO (IOToDiffArray a ix e)-freezeDiffArray a = do- (l,u) <- getBounds a- a' <- newArray_ (l,u)- sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]- var <- newMVar (Current a')- return (DiffArray var)--{-# RULES-"freeze/DiffArray" freeze = freezeDiffArray- #-}---- unsafeFreezeDiffArray is really unsafe. Better don't use the old--- array at all after freezing. The contents of the source array will--- be changed when '//' is applied to the resulting array.--unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)- => a ix e- -> IO (IOToDiffArray a ix e)-unsafeFreezeDiffArray a = do- var <- newMVar (Current a)- return (DiffArray var)--{-# RULES-"unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray- #-}--thawDiffArray :: (MArray a e IO, Ix ix)- => IOToDiffArray a ix e- -> IO (a ix e)-thawDiffArray a = do- d <- readMVar (varDiffArray a)- case d of- Current a' -> do- (l,u) <- getBounds a'- a'' <- newArray_ (l,u)- sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]- return a''- Diff a' ies -> do- a'' <- thawDiffArray a'- sequence_ [unsafeWrite a'' i e | (i, e) <- ies]- return a''--{-# RULES-"thaw/DiffArray" thaw = thawDiffArray- #-}---- unsafeThawDiffArray is really unsafe. Better don't use the old--- array at all after thawing. The contents of the resulting array--- will be changed when '//' is applied to the source array.--unsafeThawDiffArray :: (MArray a e IO, Ix ix)- => IOToDiffArray a ix e- -> IO (a ix e)-unsafeThawDiffArray a = do- d <- readMVar (varDiffArray a)- case d of- Current a' -> return a'- Diff a' ies -> do- a'' <- unsafeThawDiffArray a'- sequence_ [unsafeWrite a'' i e | (i, e) <- ies]- return a''--{-# RULES-"unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray- #-}
Data/Array/IArray.hs view
@@ -10,7 +10,8 @@ -- -- Immutable arrays, with an overloaded interface. For array types which -- can be used with this interface, see the 'Array' type exported by this--- module, and the "Data.Array.Unboxed" and "Data.Array.Diff" modules.+-- module and the "Data.Array.Unboxed" module. Other packages, such as+-- diffarray, also provide arrays using this interface. -- -----------------------------------------------------------------------------
Data/Array/IO.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -#include "HsBase.h" #-}+{-# OPTIONS_GHC -w #-} --tmp ----------------------------------------------------------------------------- -- | -- Module : Data.Array.IO@@ -32,20 +33,23 @@ import Data.Array.Base import Data.Array.IO.Internals import Data.Array.MArray+import System.IO.Error #ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C +import GHC.Exts (MutableByteArray#, RealWorld) import GHC.Arr+import GHC.IORef+import GHC.IO.Handle+import GHC.IO.Buffer+import GHC.IO.Exception -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__@@ -64,46 +68,19 @@ -- if the end of file was reached. hGetArray handle (IOUArray (STUArray _l _u n ptr)) count- | count == 0- = return 0- | count < 0 || count > n- = illegalBufferSize handle "hGetArray" count+ | count == 0 = return 0+ | count < 0 || count > n = illegalBufferSize handle "hGetArray" count | otherwise = do- wantReadableHandle "hGetArray" handle $ - \ 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- else do - let avail = w - r- copied <- if (count >= avail)- then do - memcpy_ba_baoff ptr raw (fromIntegral r) (fromIntegral avail)- writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }- return avail- else do - memcpy_ba_baoff ptr raw (fromIntegral r) (fromIntegral count)- writeIORef ref buf{ bufRPtr = r + count }- return count-- let remaining = count - copied- if remaining > 0 - then do rest <- readChunk fd is_stream ptr copied remaining- return (rest + copied)- else return count+ -- we would like to read directly into the buffer, but we can't+ -- be sure that the MutableByteArray# is pinned, so we have to+ -- allocate a separate area of memory and copy.+ allocaBytes n $ \p -> do+ r <- hGetBuf handle p n+ memcpy_ba_ptr ptr p (fromIntegral r)+ return r -readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int-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)- loop off bytes = do- r' <- readRawBuffer "readChunk" (fromIntegral fd) is_stream ptr- (fromIntegral off) (fromIntegral bytes)- let r = fromIntegral r'- if r == 0- then return (off - init_off)- else loop (off + r) (bytes - r)+foreign import ccall unsafe "memcpy"+ memcpy_ba_ptr :: MutableByteArray# RealWorld -> Ptr a -> CSize -> IO (Ptr ()) -- --------------------------------------------------------------------------- -- hPutArray@@ -116,48 +93,26 @@ -> IO () 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__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do-- old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }- <- readIORef ref-- -- enough room in handle buffer?- if (size - w > count)- -- There's enough room in the buffer:- -- just copy the data in and update bufWPtr.- then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count)- writeIORef ref old_buf{ bufWPtr = w + count }- return ()+ | count == 0 = return ()+ | count < 0 || count > n = illegalBufferSize handle "hPutArray" count+ | otherwise = do+ -- as in hGetArray, we would like to use the array directly, but+ -- we can't be sure that the MutableByteArray# is pinned.+ allocaBytes n $ \p -> do+ memcpy_ptr_ba p raw (fromIntegral n)+ hPutBuf handle p n - -- else, we have to flush- else do flushed_buf <- flushWriteBuffer fd stream old_buf- writeIORef ref flushed_buf- let this_buf = - Buffer{ bufBuf=raw, bufState=WriteBuffer, - bufRPtr=0, bufWPtr=count, bufSize=count }- flushWriteBuffer fd stream this_buf- return ()+foreign import ccall unsafe "memcpy"+ memcpy_ptr_ba :: Ptr a -> MutableByteArray# RealWorld -> CSize -> IO (Ptr ()) -- --------------------------------------------------------------------------- -- Internal Utils -foreign import ccall unsafe "__hscore_memcpy_dst_off"- memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ())-foreign import ccall unsafe "__hscore_memcpy_src_off"- memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ())- illegalBufferSize :: Handle -> String -> Int -> IO a illegalBufferSize handle fn sz = - ioException (IOError (Just handle)- InvalidArgument fn- ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])- Nothing)+ ioException (ioeSetErrorString+ (mkIOError InvalidArgument fn (Just handle) Nothing)+ ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])) #else /* !__GLASGOW_HASKELL__ */ hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int
Data/Array/IO/Internals.hs view
@@ -38,7 +38,11 @@ import Data.Ix #ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+import GHC.IOArray (IOArray(..))+#else import GHC.IOBase (IOArray(..))+#endif #endif /* __GLASGOW_HASKELL__ */ #include "Typeable.h"
array.cabal view
@@ -1,29 +1,31 @@ name: array-version: 0.2.0.0+version: 0.3.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org+bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29 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+cabal-version: >=1.6 build-type: Simple extra-source-files: include/Typeable.h +source-repository head+ type: darcs+ location: http://darcs.haskell.org/packages/array/+ library- build-depends: base- if !impl(nhc98)- build-depends: syb+ build-depends: base >= 3 && < 5 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