array (empty) → 0.1.0.0
raw patch · 13 files changed
+3480/−0 lines, 13 filesdep +basesetup-changed
Dependencies added: base
Files
- Data/Array.hs +98/−0
- Data/Array/Base.hs +1852/−0
- Data/Array/Diff.hs +449/−0
- Data/Array/IArray.hs +51/−0
- Data/Array/IO.hs +262/−0
- Data/Array/IO/Internals.hs +396/−0
- Data/Array/MArray.hs +55/−0
- Data/Array/ST.hs +77/−0
- Data/Array/Storable.hs +97/−0
- Data/Array/Unboxed.hs +26/−0
- LICENSE +83/−0
- Setup.hs +6/−0
- array.cabal +28/−0
+ Data/Array.hs view
@@ -0,0 +1,98 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array +-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer : libraries@haskell.org+-- Stability : provisional+-- Portability : portable+--+-- Basic non-strict arrays.+--+-- /Note:/ The "Data.Array.IArray" module provides 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+-- interface, import "Data.Array.IArray" but not "Data.Array".+-----------------------------------------------------------------------------++module Data.Array ++ ( + -- * Immutable non-strict arrays+ -- $intro+ 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:+ --+ -- Ix a => Functor (Array a)+ -- (Ix a, Eq b) => Eq (Array a b)+ -- (Ix a, Ord b) => Ord (Array a b)+ -- (Ix a, Show a, Show b) => Show (Array a b)+ -- (Ix a, Read a, Read b) => Read (Array a b)+ -- ++ -- Implementation checked wrt. Haskell 98 lib report, 1/99.++ ) where++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+#endif++#ifdef __HUGS__+import Hugs.Array+#endif++#ifdef __NHC__+import Array -- Haskell'98 arrays+#else++import Control.Applicative+import Data.Foldable+import Data.Typeable+import Data.Traversable++{- $intro+Haskell provides indexable /arrays/, which may be thought of as functions+whose domains are isomorphic to contiguous subsets of the integers.+Functions restricted in this way can be implemented efficiently;+in particular, a programmer may reasonably expect rapid access to+the components. To ensure the possibility of such an implementation,+arrays are treated as data, not as general functions.++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)++#endif
+ Data/Array/Base.hs view
@@ -0,0 +1,1852 @@+{-# OPTIONS_GHC -fno-bang-patterns #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.Base+-- 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 (MPTCs, uses Control.Monad.ST)+--+-- Basis for IArray and MArray. Not intended for external consumption;+-- use IArray or MArray instead.+--+-----------------------------------------------------------------------------++-- #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 Foreign.C.Types+import Foreign.Ptr+import Foreign.StablePtr++#ifdef __GLASGOW_HASKELL__+import GHC.Arr ( STArray, unsafeIndex )+import qualified GHC.Arr as Arr+import qualified GHC.Arr as ArrST+import GHC.ST ( ST(..), runST )+import GHC.Base+import GHC.Word ( Word(..) )+import GHC.Ptr ( Ptr(..), FunPtr(..), nullPtr, nullFunPtr )+import GHC.Float ( Float(..), Double(..) )+import GHC.Stable ( StablePtr(..) )+import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )+import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )+import GHC.IOBase ( IO(..) )+#endif++#ifdef __HUGS__+import Data.Bits+import Foreign.Storable+import qualified Hugs.Array as Arr+import qualified Hugs.ST as ArrST+import Hugs.Array ( unsafeIndex )+import Hugs.ST ( STArray, ST(..), runST )+import Hugs.ByteArray+#endif++import Data.Typeable+#include "Typeable.h"++#ifdef __GLASGOW_HASKELL__+#include "MachDeps.h"+#endif++-----------------------------------------------------------------------------+-- Class of immutable arrays++{- | Class of immutable array types.++An array type has the form @(a i e)@ where @a@ is the array type+constructor (kind @* -> * -> *@), @i@ is the index type (a member of+the class 'Ix'), and @e@ is the element type. The @IArray@ class is+parameterised over both @a@ and @e@, so that instances specialised to+certain element types can be defined.+-}+class IArray a e where+ -- | Extracts the bounds of an immutable array+ bounds :: Ix i => a i e -> (i,i)+ numElements :: Ix i => a i e -> Int+ unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e+ unsafeAt :: Ix i => a i e -> Int -> e+ unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e+ unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e+ unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e++ unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze)+ unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze)+ unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze)++{-# INLINE safeRangeSize #-}+safeRangeSize :: Ix i => (i, i) -> Int+safeRangeSize (l,u) = let r = rangeSize (l, u)+ in if r < 0 then error "Negative range size"+ else r++{-# INLINE safeIndex #-}+safeIndex :: Ix i => (i, i) -> Int -> i -> Int+safeIndex (l,u) n i = let i' = unsafeIndex (l,u) i+ in if (0 <= i') && (i' < n)+ then i'+ else error "Error in array index"++{-# INLINE unsafeReplaceST #-}+unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)+unsafeReplaceST arr ies = do+ marr <- thaw arr+ sequence_ [unsafeWrite marr i e | (i, e) <- ies]+ return marr++{-# INLINE unsafeAccumST #-}+unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)+unsafeAccumST f arr ies = do+ marr <- thaw arr+ sequence_ [do+ old <- unsafeRead marr i+ unsafeWrite marr i (f old new)+ | (i, new) <- ies]+ return marr++{-# INLINE unsafeAccumArrayST #-}+unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)+unsafeAccumArrayST f e (l,u) ies = do+ marr <- newArray (l,u) e+ sequence_ [do+ old <- unsafeRead marr i+ unsafeWrite marr i (f old new)+ | (i, new) <- ies]+ return marr+++{-# INLINE array #-} ++{-| Constructs an immutable array from a pair of bounds and a list of+initial associations.++The bounds are specified as a pair of the lowest and highest bounds in+the array respectively. For example, a one-origin vector of length 10+has bounds (1,10), and a one-origin 10 by 10 matrix has bounds+((1,1),(10,10)).++An association is a pair of the form @(i,x)@, which defines the value of+the array at index @i@ to be @x@. The array is undefined if any index+in the list is out of bounds. If any two associations in the list have+the same index, the value at that index is implementation-dependent.+(In GHC, the last value specified for that index is used.+Other implementations will also do this for unboxed arrays, but Haskell+98 requires that for 'Array' the value at such indices is bottom.)++Because the indices must be checked for these errors, 'array' is+strict in the bounds argument and in the indices of the association+list. Whether @array@ is strict or non-strict in the elements depends+on the array type: 'Data.Array.Array' is a non-strict array type, but+all of the 'Data.Array.Unboxed.UArray' arrays are strict. Thus in a+non-strict array, recurrences such as the following are possible:++> a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]])++Not every index within the bounds of the array need appear in the+association list, but the values associated with indices that do not+appear will be undefined.++If, in any dimension, the lower bound is greater than the upper bound,+then the array is legal, but empty. Indexing an empty array always+gives an array-bounds error, but 'bounds' still yields the bounds with+which the array was constructed.+-}+array :: (IArray a e, Ix i) + => (i,i) -- ^ bounds of the array: (lowest,highest)+ -> [(i, e)] -- ^ list of associations+ -> a i e+array (l,u) ies+ = let n = safeRangeSize (l,u)+ in unsafeArray (l,u)+ [(safeIndex (l,u) n i, e) | (i, e) <- ies]++-- Since unsafeFreeze is not guaranteed to be only a cast, we will+-- use unsafeArray and zip instead of a specialized loop to implement+-- listArray, unlike Array.listArray, even though it generates some+-- unnecessary heap allocation. Will use the loop only when we have+-- fast unsafeFreeze, namely for Array and UArray (well, they cover+-- almost all cases).++{-# INLINE listArray #-}++-- | Constructs an immutable array from a list of initial elements.+-- The list gives the elements of the array in ascending order+-- beginning with the lowest index.+listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e+listArray (l,u) es =+ let n = safeRangeSize (l,u)+ in unsafeArray (l,u) (zip [0 .. n - 1] es)++{-# INLINE listArrayST #-}+listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)+listArrayST (l,u) es = do+ marr <- newArray_ (l,u)+ let n = safeRangeSize (l,u)+ let fillFromList i xs | i == n = return ()+ | otherwise = case xs of+ [] -> return ()+ y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys+ fillFromList 0 es+ return marr++{-# RULES+"listArray/Array" listArray =+ \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)+ #-}++{-# INLINE listUArrayST #-}+listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)+ => (i,i) -> [e] -> ST s (STUArray s i e)+listUArrayST (l,u) es = do+ marr <- newArray_ (l,u)+ let n = safeRangeSize (l,u)+ let fillFromList i xs | i == n = return ()+ | otherwise = case xs of+ [] -> return ()+ y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys+ fillFromList 0 es+ return marr++-- I don't know how to write a single rule for listUArrayST, because+-- the type looks like constrained over 's', which runST doesn't+-- like. In fact all MArray (STUArray s) instances are polymorphic+-- wrt. 's', but runST can't know that.+--+-- More precisely, we'd like to write this:+-- listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i)+-- => (i,i) -> [e] -> UArray i e+-- listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray)+-- {-# RULES listArray = listUArray+-- Then we could call listUArray at any type 'e' that had a suitable+-- MArray instance. But sadly we can't, because we don't have quantified +-- constraints. Hence the mass of rules below.++-- I would like also to write a rule for listUArrayST (or listArray or+-- whatever) applied to unpackCString#. Unfortunately unpackCString#+-- calls seem to be floated out, then floated back into the middle+-- of listUArrayST, so I was not able to do this.++#ifdef __GLASGOW_HASKELL__+type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e++{-# RULES+"listArray/UArray/Bool" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool+"listArray/UArray/Char" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char+"listArray/UArray/Int" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int+"listArray/UArray/Word" listArray + = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word+"listArray/UArray/Ptr" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a)+"listArray/UArray/FunPtr" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a)+"listArray/UArray/Float" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float+"listArray/UArray/Double" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double+"listArray/UArray/StablePtr" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a)+"listArray/UArray/Int8" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8+"listArray/UArray/Int16" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16+"listArray/UArray/Int32" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32+"listArray/UArray/Int64" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64+"listArray/UArray/Word8" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8+"listArray/UArray/Word16" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16+"listArray/UArray/Word32" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32+"listArray/UArray/Word64" listArray+ = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64+ #-}+#endif++{-# INLINE (!) #-}+-- | Returns the element of an immutable array at the specified index.+(!) :: (IArray a e, Ix i) => a i e -> i -> e+arr ! i = case bounds arr of+ (l,u) -> unsafeAt arr $ safeIndex (l,u) (numElements arr) i++{-# INLINE indices #-}+-- | Returns a list of all the valid indices in an array.+indices :: (IArray a e, Ix i) => a i e -> [i]+indices arr = case bounds arr of (l,u) -> range (l,u)++{-# INLINE elems #-}+-- | Returns a list of all the elements of an array, in the same order+-- as their indices.+elems :: (IArray a e, Ix i) => a i e -> [e]+elems arr = case bounds arr of+ (l,u) -> [unsafeAt arr i | i <- [0 .. numElements arr - 1]]++{-# INLINE assocs #-}+-- | Returns the contents of an array as a list of associations.+assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]+assocs arr = case bounds arr of+ (l,u) -> [(i, arr ! i) | i <- range (l,u)]++{-# INLINE accumArray #-}++{-| +Constructs an immutable array from a list of associations. Unlike+'array', the same index is allowed to occur multiple times in the list+of associations; an /accumulating function/ is used to combine the+values of elements with the same index.++For example, given a list of values of some index type, hist produces+a histogram of the number of occurrences of each index within a+specified range:++> hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b+> hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i]+-}+accumArray :: (IArray a e, Ix i)+ => (e -> e' -> e) -- ^ An accumulating function+ -> e -- ^ A default element+ -> (i,i) -- ^ The bounds of the array+ -> [(i, e')] -- ^ List of associations+ -> a i e -- ^ Returns: the array+accumArray f init (l,u) ies =+ let n = safeRangeSize (l, u)+ in unsafeAccumArray f init (l,u)+ [(safeIndex (l,u) n i, e) | (i, e) <- ies]++{-# INLINE (//) #-}+{-|+Takes an array and a list of pairs and returns an array identical to+the left argument except that it has been updated by the associations+in the right argument. For example, if m is a 1-origin, n by n matrix,+then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with+the diagonal zeroed.++As with the 'array' function, if any two associations in the list have+the same index, the value at that index is implementation-dependent.+(In GHC, the last value specified for that index is used.+Other implementations will also do this for unboxed arrays, but Haskell+98 requires that for 'Array' the value at such indices is bottom.)++For most array types, this operation is O(/n/) where /n/ is the size+of the array. However, the 'Data.Array.Diff.DiffArray' type provides+this operation with complexity linear in the number of updates.+-}+(//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e+arr // ies = case bounds arr of+ (l,u) -> unsafeReplace arr [ (safeIndex (l,u) (numElements arr) i, e)+ | (i, e) <- ies]++{-# INLINE accum #-}+{-|+@accum f@ takes an array and an association list and accumulates pairs+from the list into the array with the accumulating function @f@. Thus+'accumArray' can be defined using 'accum':++> accumArray f z b = accum f (array b [(i, z) | i \<- range b])+-}+accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e+accum f arr ies = case bounds arr of+ (l,u) -> let n = numElements arr+ in unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]++{-# INLINE amap #-}+-- | Returns a new array derived from the original array by applying a+-- function to each of the elements.+amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e+amap f arr = case bounds arr of+ (l,u) -> let n = numElements arr+ in unsafeArray (l,u) [ (i, f (unsafeAt arr i))+ | i <- [0 .. n - 1]]++{-# INLINE ixmap #-}+-- | Returns a new array derived from the original array by applying a+-- function to each of the indices.+ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e+ixmap (l,u) f arr =+ array (l,u) [(i, arr ! f i) | i <- range (l,u)]++-----------------------------------------------------------------------------+-- Normal polymorphic arrays++instance IArray Arr.Array e where+ {-# INLINE bounds #-}+ bounds = Arr.bounds+ {-# INLINE numElements #-}+ numElements = Arr.numElements+ {-# INLINE unsafeArray #-}+ unsafeArray = Arr.unsafeArray+ {-# INLINE unsafeAt #-}+ unsafeAt = Arr.unsafeAt+ {-# INLINE unsafeReplace #-}+ unsafeReplace = Arr.unsafeReplace+ {-# INLINE unsafeAccum #-}+ unsafeAccum = Arr.unsafeAccum+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray = Arr.unsafeAccumArray++-----------------------------------------------------------------------------+-- Flat unboxed arrays++-- | Arrays with unboxed elements. Instances of 'IArray' are provided+-- for 'UArray' with certain element types ('Int', 'Float', 'Char',+-- etc.; see the 'UArray' class for a full list).+--+-- A 'UArray' will generally be more efficient (in terms of both time+-- and space) than the equivalent 'Data.Array.Array' with the same+-- element type. However, 'UArray' is strict in its elements - so+-- don\'t use 'UArray' if you require the non-strictness that+-- 'Data.Array.Array' provides.+--+-- Because the @IArray@ interface provides operations overloaded on+-- the type of the array, it should be possible to just change the+-- array type being used by a program from say @Array@ to @UArray@ to+-- 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 !Int ByteArray#+#endif+#ifdef __HUGS__+data UArray i e = UArray !i !i !Int !ByteArray+#endif++INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")++{-# INLINE unsafeArrayUArray #-}+unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)+ => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)+unsafeArrayUArray (l,u) ies default_elem = do+ marr <- newArray (l,u) default_elem+ sequence_ [unsafeWrite marr i e | (i, e) <- ies]+ unsafeFreezeSTUArray marr++#ifdef __GLASGOW_HASKELL__+{-# INLINE unsafeFreezeSTUArray #-}+unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)+unsafeFreezeSTUArray (STUArray l u 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)+unsafeFreezeSTUArray (STUArray l u n marr) = do+ arr <- unsafeFreezeMutableByteArray marr+ return (UArray l u n arr)+#endif++{-# INLINE unsafeReplaceUArray #-}+unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)+ => UArray i e -> [(Int, e)] -> ST s (UArray i e)+unsafeReplaceUArray arr ies = do+ marr <- thawSTUArray arr+ sequence_ [unsafeWrite marr i e | (i, e) <- ies]+ unsafeFreezeSTUArray marr++{-# INLINE unsafeAccumUArray #-}+unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)+ => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)+unsafeAccumUArray f arr ies = do+ marr <- thawSTUArray arr+ sequence_ [do+ old <- unsafeRead marr i+ unsafeWrite marr i (f old new)+ | (i, new) <- ies]+ unsafeFreezeSTUArray marr++{-# 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+ sequence_ [do+ old <- unsafeRead marr i+ unsafeWrite marr i (f old new)+ | (i, new) <- ies]+ unsafeFreezeSTUArray marr++{-# INLINE eqUArray #-}+eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool+eqUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) =+ if n1 == 0 then n2 == 0 else+ l1 == l2 && u1 == u2 &&+ and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]]++{-# INLINE cmpUArray #-}+cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering+cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++{-# INLINE cmpIntUArray #-}+cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering+cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) =+ if n1 == 0 then if n2 == 0 then EQ else LT else+ if n2 == 0 then GT else+ case compare l1 l2 of+ EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1]+ other -> other+ where+ cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of+ EQ -> rest+ other -> other++{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}++-----------------------------------------------------------------------------+-- Showing IArrays++{-# SPECIALISE + showsIArray :: (IArray UArray e, Ix i, Show i, Show e) => + Int -> UArray i e -> ShowS+ #-}++showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS+showsIArray p a =+ showParen (p > 9) $+ showString "array " .+ shows (bounds a) .+ showChar ' ' .+ shows (assocs a)++-----------------------------------------------------------------------------+-- 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 bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Char where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Int where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Word where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# INLINE unsafeArray #-}+ unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+#ifdef __GLASGOW_HASKELL__+ {-# INLINE unsafeAt #-}+ unsafeAt (UArray _ _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)+#endif+#ifdef __HUGS__+ unsafeAt = unsafeAtBArray+#endif+ {-# INLINE unsafeReplace #-}+ unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+ {-# INLINE unsafeAccum #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray (Ptr a) where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray (FunPtr a) where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Float where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Double where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray (StablePtr a) where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++-- bogus StablePtr value for initialising a UArray of StablePtr.+#ifdef __GLASGOW_HASKELL__+nullStablePtr = StablePtr (unsafeCoerce# 0#)+#endif+#ifdef __HUGS__+nullStablePtr = castPtrToStablePtr nullPtr+#endif++instance IArray UArray Int8 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Int16 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Int32 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Int64 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Word8 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Word16 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Word32 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance IArray UArray Word64 where+ {-# INLINE bounds #-}+ bounds (UArray l u _ _) = (l,u)+ {-# INLINE numElements #-}+ numElements (UArray _ _ n _) = n+ {-# 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 #-}+ unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+ {-# INLINE unsafeAccumArray #-}+ unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)++instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where+ (==) = eqUArray++instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where+ compare = cmpUArray++instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where+ showsPrec = showsIArray++-----------------------------------------------------------------------------+-- Mutable arrays++{-# NOINLINE arrEleBottom #-}+arrEleBottom :: a+arrEleBottom = error "MArray: undefined array element"++{-| Class of mutable array types.++An array type has the form @(a i e)@ where @a@ is the array type+constructor (kind @* -> * -> *@), @i@ is the index type (a member of+the class 'Ix'), and @e@ is the element type.++The @MArray@ class is parameterised over both @a@ and @e@ (so that+instances specialised to certain element types can be defined, in the+same way as for 'IArray'), and also over the type of the monad, @m@,+in which the mutable array will be manipulated.+-}+class (Monad m) => MArray a e m where++ -- | Returns the bounds of the array+ getBounds :: Ix i => a i e -> m (i,i)+ -- | Returns the number of elements in the array+ getNumElements :: Ix i => a i e -> m Int++ -- | Builds a new array, with every element initialised to the supplied + -- value.+ newArray :: Ix i => (i,i) -> e -> m (a i e)++ -- | Builds a new array, with every element initialised to an+ -- undefined value. In a monadic context in which operations must+ -- be deterministic (e.g. the ST monad), the array elements are+ -- initialised to a fixed but undefined value, such as zero.+ newArray_ :: Ix i => (i,i) -> m (a i e)++ -- | Builds a new array, with every element initialised to an undefined+ -- value.+ unsafeNewArray_ :: Ix i => (i,i) -> m (a i e)++ unsafeRead :: Ix i => a i e -> Int -> m e+ unsafeWrite :: Ix i => a i e -> Int -> e -> m ()++ {-# INLINE newArray #-}+ -- The INLINE is crucial, because until we know at least which monad + -- we are in, the code below allocates like crazy. So inline it,+ -- in the hope that the context will know the monad.+ newArray (l,u) init = do+ let n = safeRangeSize (l,u)+ marr <- unsafeNewArray_ (l,u)+ sequence_ [unsafeWrite marr i init | i <- [0 .. n - 1]]+ return marr++ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom++ {-# INLINE newArray_ #-}+ newArray_ (l,u) = newArray (l,u) arrEleBottom++ -- newArray takes an initialiser which all elements of+ -- the newly created array are initialised to. unsafeNewArray_ takes+ -- no initialiser, it is assumed that the array is initialised with+ -- "undefined" values.++ -- why not omit unsafeNewArray_? Because in the unboxed array+ -- case we would like to omit the initialisation altogether if+ -- possible. We can't do this for boxed arrays, because the+ -- elements must all have valid values at all times in case of+ -- garbage collection.++ -- why not omit newArray? Because in the boxed case, we can omit the+ -- default initialisation with undefined values if we *do* know the+ -- initial value and it is constant for all elements.++{-# INLINE newListArray #-}+-- | Constructs a mutable array from a list of initial elements.+-- The list gives the elements of the array in ascending order+-- beginning with the lowest index.+newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)+newListArray (l,u) es = do+ marr <- newArray_ (l,u)+ let n = safeRangeSize (l,u)+ let fillFromList i xs | i == n = return ()+ | otherwise = case xs of+ [] -> return ()+ y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys+ fillFromList 0 es+ return marr++{-# INLINE readArray #-}+-- | Read an element from a mutable array+readArray :: (MArray a e m, Ix i) => a i e -> i -> m e+readArray marr i = do+ (l,u) <- getBounds marr+ n <- getNumElements marr+ unsafeRead marr (safeIndex (l,u) n i)++{-# INLINE writeArray #-}+-- | Write an element in a mutable array+writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()+writeArray marr i e = do+ (l,u) <- getBounds marr+ n <- getNumElements marr+ unsafeWrite marr (safeIndex (l,u) n i) e++{-# INLINE getElems #-}+-- | Return a list of all the elements of a mutable array+getElems :: (MArray a e m, Ix i) => a i e -> m [e]+getElems marr = do + (l,u) <- getBounds marr+ n <- getNumElements marr+ sequence [unsafeRead marr i | i <- [0 .. n - 1]]++{-# INLINE getAssocs #-}+-- | Return a list of all the associations of a mutable array, in+-- index order.+getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]+getAssocs marr = do + (l,u) <- getBounds marr+ n <- getNumElements marr+ sequence [ do e <- unsafeRead marr (safeIndex (l,u) n i); return (i,e)+ | i <- range (l,u)]++{-# INLINE mapArray #-}+-- | Constructs a new array derived from the original array by applying a+-- function to each of the elements.+mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)+mapArray f marr = do + (l,u) <- getBounds marr+ n <- getNumElements marr+ marr' <- newArray_ (l,u)+ sequence_ [do+ e <- unsafeRead marr i+ unsafeWrite marr' i (f e)+ | i <- [0 .. n - 1]]+ return marr'++{-# INLINE mapIndices #-}+-- | Constructs a new array derived from the original array by applying a+-- function to each of the indices.+mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)+mapIndices (l',u') f marr = do+ marr' <- newArray_ (l',u')+ n' <- getNumElements marr'+ sequence_ [do+ e <- readArray marr (f i')+ unsafeWrite marr' (safeIndex (l',u') n' i') e+ | i' <- range (l',u')]+ return marr'++-----------------------------------------------------------------------------+-- Polymorphic non-strict mutable arrays (ST monad)++instance MArray (STArray s) e (ST s) where+ {-# INLINE getBounds #-}+ getBounds arr = return $! ArrST.boundsSTArray arr+ {-# INLINE getNumElements #-}+ getNumElements arr = return $! ArrST.numElementsSTArray arr+ {-# INLINE newArray #-}+ newArray = ArrST.newSTArray+ {-# INLINE unsafeRead #-}+ unsafeRead = ArrST.unsafeReadSTArray+ {-# INLINE unsafeWrite #-}+ unsafeWrite = ArrST.unsafeWriteSTArray++instance MArray (STArray s) e (Lazy.ST s) where+ {-# INLINE getBounds #-}+ getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)+ {-# INLINE getNumElements #-}+ getNumElements arr = strictToLazyST (return $! ArrST.numElementsSTArray arr)+ {-# INLINE newArray #-}+ newArray (l,u) e = strictToLazyST (ArrST.newSTArray (l,u) e)+ {-# INLINE unsafeRead #-}+ unsafeRead arr i = strictToLazyST (ArrST.unsafeReadSTArray arr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)++#ifdef __HUGS__+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")+#endif++-----------------------------------------------------------------------------+-- Flat unboxed mutable arrays (ST monad)++-- | A mutable array with unboxed elements, that can be manipulated in+-- the 'ST' monad. The type arguments are as follows:+--+-- * @s@: the state variable argument for the 'ST' type+--+-- * @i@: the index type of the array (should be an instance of @Ix@)+--+-- * @e@: the element type of the array. Only certain element types+-- are supported.+--+-- An 'STUArray' will generally be more efficient (in terms of both time+-- and space) than the equivalent boxed version ('STArray') with the same+-- 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 !Int (MutableByteArray# s)+#endif+#ifdef __HUGS__+data STUArray s i a = STUArray !i !i !Int !(MutableByteArray s)+#endif++INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")++instance Eq (STUArray s i e) where+ STUArray _ _ _ arr1# == STUArray _ _ _ arr2# =+ sameMutableByteArray# arr1# arr2#++#ifdef __GLASGOW_HASKELL__+{-# INLINE unsafeNewArraySTUArray_ #-}+unsafeNewArraySTUArray_ :: Ix i+ => (i,i) -> (Int# -> Int#) -> ST s (STUArray s i e)+unsafeNewArraySTUArray_ (l,u) elemsToBytes+ = case rangeSize (l,u) of+ n@(I# n#) ->+ ST $ \s1# ->+ case newByteArray# (elemsToBytes n#) s1# of+ (# s2#, marr# #) ->+ (# s2#, STUArray l u n marr# #)++instance MArray (STUArray s) Bool (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE newArray #-}+ newArray (l,u) init = 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'# ->+ let loop i# s3# | i# ==# n'# = s3#+ | otherwise =+ case writeWordArray# marr# i# e# s3# of { s4# ->+ loop (i# +# 1#) s4# } in+ case loop 0# s2# of { s3# ->+ (# s3#, STUArray l u n marr# #) }}}}+ where+ W# e# = if init then maxBound else 0+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds False+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->+ (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->+ case bOOL_INDEX i# of { j# ->+ case readWordArray# marr# j# s1# of { (# s2#, old# #) ->+ case if e then old# `or#` bOOL_BIT i#+ else old# `and#` bOOL_NOT_BIT i# of { e# ->+ case writeWordArray# marr# j# e# s2# of { s3# ->+ (# s3#, () #) }}}}++instance MArray (STUArray s) Char (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds (chr 0)+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, C# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->+ case writeWideCharArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Int (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readIntArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, I# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->+ case writeIntArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Word (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWordArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, W# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->+ case writeWordArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) (Ptr a) (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds nullPtr+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, Ptr e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->+ case writeAddrArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) (FunPtr a) (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds nullFunPtr+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, FunPtr e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->+ case writeAddrArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Float (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) fLOAT_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, F# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->+ case writeFloatArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Double (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) dOUBLE_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, D# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->+ case writeDoubleArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) (StablePtr a) (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds (castPtrToStablePtr nullPtr)+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->+ (# s2# , StablePtr e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->+ case writeStablePtrArray# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Int8 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, I8# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->+ case writeInt8Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Int16 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 2#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, I16# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->+ case writeInt16Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Int32 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, I32# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->+ case writeInt32Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Int64 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 8#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> + case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, I64# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->+ case writeInt64Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Word8 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, W8# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->+ case writeWord8Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Word16 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 2#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, W16# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->+ case writeWord16Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Word32 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, W32# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->+ case writeWord32Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++instance MArray (STUArray s) Word64 (ST s) where+ {-# INLINE getBounds #-}+ getBounds (STUArray l u _ _) = return (l,u)+ {-# INLINE getNumElements #-}+ getNumElements (STUArray _ _ n _) = return n+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 8#)+ {-# INLINE newArray_ #-}+ newArray_ bounds = newArray bounds 0+ {-# INLINE unsafeRead #-}+ unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->+ case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->+ (# s2#, W64# e# #) }+ {-# INLINE unsafeWrite #-}+ unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->+ case writeWord64Array# marr# i# e# s1# of { s2# ->+ (# s2#, () #) }++-----------------------------------------------------------------------------+-- Translation between elements and bytes++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+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++bOOL_INDEX :: Int# -> Int#+#if SIZEOF_HSWORD == 4+bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#+#elif SIZEOF_HSWORD == 8+bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#+#endif++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+#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+ let n = safeRangeSize (l,u)+ marr <- newMutableByteArray (n * sizeOf dummy)+ return (STUArray l u n 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++getBoundsMBArray :: Storable e => STUArray s i e -> ST s (i, i)+getBoundsMBArray (STUArray l u _ _) = return (l,u)++getNumElementsMBArray :: Storable e => STUArray s i e -> ST s Int+getNumElementsMBArray (STUArray _ _ n _) = return n++instance MArray (STUArray s) Bool (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ (l,u) = do+ let n = rangeSize (l,u)+ marr <- newMutableByteArray (bOOL_SCALE n)+ return (STUArray l u n marr)+ newArray_ bounds = unsafeNewArray_ bounds+ 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+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Int (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Word (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) (Ptr a) (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) (FunPtr a) (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Float (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Double (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) (StablePtr a) (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Int8 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Int16 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Int32 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Int64 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Word8 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Word16 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Word32 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ unsafeRead = unsafeReadMBArray+ unsafeWrite = unsafeWriteMBArray++instance MArray (STUArray s) Word64 (ST s) where+ getBounds = getBoundsMBArray+ getNumElements = getNumElementsMBArray+ unsafeNewArray_ = newMBArray_+ newArray_ = unsafeNewArray_+ 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++-- | Converts a mutable array (any instance of 'MArray') to an+-- immutable array (any instance of 'IArray') by taking a complete+-- copy of it.+freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+freeze marr = 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)++#ifdef __GLASGOW_HASKELL__+freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)+freezeSTUArray (STUArray l u n marr#) = ST $ \s1# ->+ case sizeofMutableByteArray# marr# of { n# ->+ case newByteArray# n# s1# of { (# s2#, marr'# #) ->+ case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->+ case unsafeCoerce# m s2# of { (# s3#, _ #) ->+ case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->+ (# s4#, UArray l u n arr# #) }}}}}++foreign import ccall unsafe "memcpy"+ memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize+ -> IO (Ptr a)++{-# RULES+"freeze/STArray" freeze = ArrST.freezeSTArray+"freeze/STUArray" freeze = freezeSTUArray+ #-}+#endif /* __GLASGOW_HASKELL__ */++-- In-place conversion of mutable arrays to immutable ones places+-- a proof obligation on the user: no other parts of your code can+-- have a reference to the array at the point where you unsafely+-- freeze it (and, subsequently mutate it, I suspect).++{- |+ Converts an mutable array into an immutable array. The + implementation may either simply cast the array from+ one type to the other without copying the array, or it+ may take a full copy of the array.++ Note that because the array is possibly not copied, any subsequent+ modifications made to the mutable version of the array may be+ shared with the immutable version. It is safe to use, therefore, if+ the mutable version is never modified after the freeze operation.++ The non-copying implementation is supported between certain pairs+ of array types only; one constraint is that the array types must+ have identical representations. In GHC, The following pairs of+ array types have a non-copying O(1) implementation of+ 'unsafeFreeze'. Because the optimised versions are enabled by+ specialisations, you will need to compile with optimisation (-O) to+ get them.++ * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray'++ * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray'++ * 'Data.Array.IO.IOArray' -> 'Data.Array.Array'++ * 'Data.Array.ST.STArray' -> 'Data.Array.Array'+-}+{-# INLINE unsafeFreeze #-}+unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+unsafeFreeze = freeze++{-# RULES+"unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray+"unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray+ #-}++-----------------------------------------------------------------------------+-- Thawing++-- | Converts an immutable array (any instance of 'IArray') into a+-- mutable array (any instance of 'MArray') by taking a complete copy+-- of it.+thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+thaw arr = case bounds arr of+ (l,u) -> do+ marr <- newArray_ (l,u)+ let n = safeRangeSize (l,u)+ sequence_ [ unsafeWrite marr i (unsafeAt arr i)+ | i <- [0 .. n - 1]]+ return marr++#ifdef __GLASGOW_HASKELL__+thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)+thawSTUArray (UArray l u n arr#) = ST $ \s1# ->+ case sizeofByteArray# arr# of { n# ->+ case newByteArray# n# s1# of { (# s2#, marr# #) ->+ case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->+ case unsafeCoerce# m s2# of { (# s3#, _ #) ->+ (# s3#, STUArray l u n marr# #) }}}}++foreign import ccall unsafe "memcpy"+ memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize+ -> IO (Ptr a)++{-# RULES+"thaw/STArray" thaw = ArrST.thawSTArray+"thaw/STUArray" thaw = thawSTUArray+ #-}+#endif /* __GLASGOW_HASKELL__ */++#ifdef __HUGS__+thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)+thawSTUArray (UArray l u n arr) = do+ marr <- thawByteArray arr+ return (STUArray l u n marr)+#endif++-- In-place conversion of immutable arrays to mutable ones places+-- a proof obligation on the user: no other parts of your code can+-- have a reference to the array at the point where you unsafely+-- thaw it (and, subsequently mutate it, I suspect).++{- |+ Converts an immutable array into a mutable array. The + implementation may either simply cast the array from+ one type to the other without copying the array, or it+ may take a full copy of the array. ++ Note that because the array is possibly not copied, any subsequent+ modifications made to the mutable version of the array may be+ shared with the immutable version. It is only safe to use,+ therefore, if the immutable array is never referenced again in this+ thread, and there is no possibility that it can be also referenced+ in another thread. If you use an unsafeThaw/write/unsafeFreeze+ sequence in a multi-threaded setting, then you must ensure that+ this sequence is atomic with respect to other threads, or a garbage+ collector crash may result (because the write may be writing to a+ frozen array).++ The non-copying implementation is supported between certain pairs+ of array types only; one constraint is that the array types must+ have identical representations. In GHC, The following pairs of+ array types have a non-copying O(1) implementation of+ 'unsafeThaw'. Because the optimised versions are enabled by+ specialisations, you will need to compile with optimisation (-O) to+ get them.++ * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray'++ * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray'++ * 'Data.Array.Array' -> 'Data.Array.IO.IOArray'++ * 'Data.Array.Array' -> 'Data.Array.ST.STArray'+-}+{-# INLINE unsafeThaw #-}+unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+unsafeThaw = thaw++#ifdef __GLASGOW_HASKELL__+{-# INLINE unsafeThawSTUArray #-}+unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)+unsafeThawSTUArray (UArray l u n marr#) =+ return (STUArray l u n (unsafeCoerce# marr#))++{-# RULES+"unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray+"unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray+ #-}+#endif /* __GLASGOW_HASKELL__ */++-- | Casts an 'STUArray' with one element type into one with a+-- different element type. All the elements of the resulting array+-- are undefined (unless you know what you\'re doing...).++#ifdef __GLASGOW_HASKELL__+castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)+castSTUArray (STUArray l u n marr#) = return (STUArray l u n marr#)+#endif++#ifdef __HUGS__+castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)+castSTUArray (STUArray l u n marr) = return (STUArray l u n marr)+#endif
+ Data/Array/Diff.hs view
@@ -0,0 +1,449 @@+-----------------------------------------------------------------------------+-- |+-- 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 Prelude++import Data.Ix+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+-- -fallow-undecidable-instances, 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 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) 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)+a `replaceDiffArray2` ies = do+ mapM_ (\(a,b) -> do evaluate a; evaluate b) ies+ a `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
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.IArray+-- 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.Base)+--+-- 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 Data.Array.IArray ( + -- * Array classes+ IArray, -- :: (* -> * -> *) -> * -> class++ module Data.Ix,++ -- * Immutable non-strict (boxed) arrays+ Array, ++ -- * Array construction+ array, -- :: (IArray a e, Ix i) => (i,i) -> [(i, e)] -> a i e+ listArray, -- :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e+ accumArray, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(i, e')] -> a i e++ -- * Accessing arrays+ (!), -- :: (IArray a e, Ix i) => a i e -> i -> e+ bounds, -- :: (HasBounds a, Ix i) => a i e -> (i,i)+ indices, -- :: (HasBounds a, Ix i) => a i e -> [i]+ elems, -- :: (IArray a e, Ix i) => a i e -> [e]+ assocs, -- :: (IArray a e, Ix i) => a i e -> [(i, e)]++ -- * Incremental array updates+ (//), -- :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e+ accum, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e++ -- * Derived arrays+ amap, -- :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e+ 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
@@ -0,0 +1,262 @@+{-# OPTIONS_GHC -#include "HsBase.h" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.IO+-- 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.MArray)+--+-- Mutable boxed and unboxed arrays in the IO monad.+--+-----------------------------------------------------------------------------++module Data.Array.IO (+ -- * @IO@ arrays with boxed elements+ IOArray, -- instance of: Eq, Typeable++ -- * @IO@ arrays with unboxed elements+ IOUArray, -- instance of: Eq, Typeable+ castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b)++ -- * Overloaded mutable array interface+ module Data.Array.MArray,++ -- * Doing I\/O with @IOUArray@s+ hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int+ 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 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++-- | Reads a number of 'Word8's from the specified 'Handle' directly+-- into an array.+hGetArray+ :: Handle -- ^ Handle to read from+ -> IOUArray Int Word8 -- ^ Array in which to place the values+ -> Int -- ^ Number of 'Word8's to read+ -> IO Int+ -- ^ Returns: the number of 'Word8's actually + -- 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+ | 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+ 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++readChunk :: FD -> Bool -> RawBuffer -> Int -> Int -> IO Int+readChunk fd is_stream ptr init_off bytes = loop init_off bytes + 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)++-- ---------------------------------------------------------------------------+-- hPutArray++-- | Writes an array of 'Word8' to the specified 'Handle'.+hPutArray+ :: Handle -- ^ Handle to write to+ -> IOUArray Int Word8 -- ^ Array to write from+ -> Int -- ^ Number of 'Word8's to write+ -> 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_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do++ old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, 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 ()++ -- 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 ()++-- ---------------------------------------------------------------------------+-- 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)++#else /* !__GLASGOW_HASKELL__ */+hGetArray :: Handle -> IOUArray Int Word8 -> Int -> IO Int+hGetArray handle arr count = do+ bds <- getBounds arr+ if count < 0 || count > rangeSize bds+ then illegalBufferSize handle "hGetArray" count+ else get 0+ where+ get i | i == count = return i+ | otherwise = do+ error_or_c <- try (hGetChar handle)+ case error_or_c of+ Left ex+ | isEOFError ex -> return i+ | otherwise -> ioError ex+ Right c -> do+ unsafeWrite arr i (fromIntegral (ord c))+ get (i+1)++hPutArray :: Handle -> IOUArray Int Word8 -> Int -> IO ()+hPutArray handle arr count = do+ bds <- getBounds arr+ if count < 0 || count > rangeSize bds+ then illegalBufferSize handle "hPutArray" count+ else put 0+ where+ put i | i == count = return ()+ | otherwise = do+ w <- unsafeRead arr i+ hPutChar handle (chr (fromIntegral w))+ put (i+1)++illegalBufferSize :: Handle -> String -> Int -> IO a+illegalBufferSize _ fn sz = ioError $+ userError (fn ++ ": illegal buffer size " ++ showsPrec 9 (sz::Int) [])+#endif /* !__GLASGOW_HASKELL__ */
+ Data/Array/IO/Internals.hs view
@@ -0,0 +1,396 @@+{-# OPTIONS_GHC -#include "HsBase.h" #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.IO.Internal+-- 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.Base)+--+-- Mutable boxed and unboxed arrays in the IO monad.+--+-----------------------------------------------------------------------------++-- #hide+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++import Data.Array.MArray+import Data.Int+import Data.Word+import Data.Typeable++#ifdef __HUGS__+import Hugs.IOArray+#endif++import Control.Monad.ST ( RealWorld, stToIO )+import Foreign.Ptr ( Ptr, FunPtr )+import Foreign.StablePtr ( StablePtr )+import Data.Array.Base++#ifdef __GLASGOW_HASKELL__+import GHC.IOBase+import GHC.Base+#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+-- arguments are as follows:+--+-- * @i@: the index type of the array (should be an instance of 'Ix')+--+-- * @e@: the element type of the array. Only certain element types+-- are supported: see "Data.Array.MArray" for a list of instances.+--+newtype IOUArray i e = IOUArray (STUArray RealWorld i e)++INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")++instance Eq (IOUArray i e) where+ IOUArray s1 == IOUArray s2 = s1 == s2++instance MArray IOUArray Bool IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Char IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Int IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Word IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray (Ptr a) IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray (FunPtr a) IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Float IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Double IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray (StablePtr a) IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Int8 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Int16 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Int32 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Int64 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Word8 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Word16 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Word32 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++instance MArray IOUArray Word64 IO where+ {-# INLINE getBounds #-}+ getBounds (IOUArray arr) = stToIO $ getBounds arr+ {-# INLINE getNumElements #-}+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr+ {-# INLINE newArray #-}+ newArray lu init = stToIO $ do+ marr <- newArray lu init; return (IOUArray marr)+ {-# INLINE unsafeNewArray_ #-}+ unsafeNewArray_ lu = stToIO $ do+ marr <- unsafeNewArray_ lu; return (IOUArray marr)+ {-# INLINE newArray_ #-}+ newArray_ = unsafeNewArray_+ {-# INLINE unsafeRead #-}+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)+ {-# INLINE unsafeWrite #-}+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)++-- | 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')+
+ Data/Array/MArray.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.MArray+-- 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.Base)+--+-- An overloaded interface to mutable arrays. For array types which can be+-- used with this interface, see "Data.Array.IO", "Data.Array.ST", +-- and "Data.Array.Storable".+--+-----------------------------------------------------------------------------++module Data.Array.MArray ( + -- * Class of mutable array types+ MArray, -- :: (* -> * -> *) -> * -> (* -> *) -> class++ -- * The @Ix@ class and operations+ module Data.Ix,++ -- * Constructing mutable arrays+ newArray, -- :: (MArray a e m, Ix i) => (i,i) -> e -> m (a i e)+ newArray_, -- :: (MArray a e m, Ix i) => (i,i) -> m (a i e)+ newListArray, -- :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)++ -- * Reading and writing mutable arrays+ readArray, -- :: (MArray a e m, Ix i) => a i e -> i -> m e+ writeArray, -- :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()++ -- * Derived arrays+ mapArray, -- :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)+ mapIndices, -- :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)++ -- * Deconstructing mutable arrays+ getBounds, -- :: (MArray a e m, Ix i) => a i e -> m (i,i)+ getElems, -- :: (MArray a e m, Ix i) => a i e -> m [e]+ getAssocs, -- :: (MArray a e m, Ix i) => a i e -> m [(i, e)]++ -- * Conversions between mutable and immutable arrays+ freeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+ unsafeFreeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+ thaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+ 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+#endif+import Data.Array.Base
+ Data/Array/ST.hs view
@@ -0,0 +1,77 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.ST+-- 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.MArray)+--+-- Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad.+--+-----------------------------------------------------------------------------++module Data.Array.ST (++ -- * Boxed arrays+ STArray, -- instance of: Eq, MArray+ runSTArray,++ -- * Unboxed arrays+ STUArray, -- instance of: Eq, MArray+ runSTUArray,+ castSTUArray, -- :: STUArray s i a -> ST s (STUArray s i b)++ -- * Overloaded mutable array interface+ 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 )++#ifdef __HUGS__+import Hugs.Array ( Array )+import Hugs.ST ( STArray, unsafeFreezeSTArray )+#endif++#ifdef __GLASGOW_HASKELL__+import GHC.Arr ( STArray, Array, unsafeFreezeSTArray )+#endif++-- | A safe way to create and work with a mutable array before returning an+-- immutable array for later perusal. This function avoids copying+-- the array before returning it - it uses 'unsafeFreeze' internally, but+-- this wrapper is a safe interface to that function.+--+runSTArray :: (Ix i)+ => (forall s . ST s (STArray s i e))+ -> Array i e+runSTArray st = runST (st >>= unsafeFreezeSTArray)++-- | A safe way to create and work with an unboxed mutable array before+-- returning an immutable array for later perusal. This function+-- avoids copying the array before returning it - it uses+-- 'unsafeFreeze' internally, but this wrapper is a safe interface to+-- that function.+--+runSTUArray :: (Ix i)+ => (forall s . ST s (STUArray s i e))+ -> UArray i e+runSTUArray st = runST (st >>= unsafeFreezeSTUArray)+++-- INTERESTING... this is the type we'd like to give to runSTUArray:+--+-- runSTUArray :: (Ix i, IArray UArray e, +-- forall s. MArray (STUArray s) e (ST s))+-- => (forall s . ST s (STUArray s i e))+-- -> UArray i e+--+-- Note the quantified constraint. We dodged the problem by using+-- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but+-- this essentially constrains us to a single unsafeFreeze for all STUArrays+-- (in theory we might have a different one for certain element types).
+ Data/Array/Storable.hs view
@@ -0,0 +1,97 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.Storable+-- 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.MArray)+--+-- A storable array is an IO-mutable array which stores its+-- contents in a contiguous memory block living in the C+-- heap. Elements are stored according to the class 'Storable'.+-- You can obtain the pointer to the array contents to manipulate+-- elements from languages like C.+--+-- It is similar to 'Data.Array.IO.IOUArray' but slower.+-- Its advantage is that it's compatible with C.+--+-----------------------------------------------------------------------------++module Data.Array.Storable (+ + -- * Arrays of 'Storable' things.+ StorableArray, -- data StorableArray index element+ -- -- index type must be in class Ix+ -- -- element type must be in class Storable+ + -- * Overloaded mutable array interface+ -- | Module "Data.Array.MArray" provides the interface of storable arrays.+ -- They are instances of class 'MArray' (with the 'IO' monad).+ module Data.Array.MArray,+ + -- * Accessing the pointer to the array contents+ withStorableArray, -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a+ + touchStorableArray, -- :: StorableArray i e -> IO ()++ unsafeForeignPtrToStorableArray+ )+ where++import Prelude++import Data.Array.Base+import Data.Array.MArray+import Foreign hiding (newArray)++-- |The array type+data StorableArray i e = StorableArray !i !i Int !(ForeignPtr e)++instance Storable e => MArray StorableArray e IO where+ getBounds (StorableArray l u _ _) = return (l,u)++ getNumElements (StorableArray l u n _) = return n++ newArray (l,u) init = do+ fp <- mallocForeignPtrArray size+ withForeignPtr fp $ \a ->+ sequence_ [pokeElemOff a i init | i <- [0..size-1]]+ return (StorableArray l u size fp)+ where+ size = rangeSize (l,u)++ unsafeNewArray_ (l,u) = do+ let n = rangeSize (l,u)+ fp <- mallocForeignPtrArray n+ return (StorableArray l u n fp)++ newArray_ = unsafeNewArray_++ unsafeRead (StorableArray _ _ _ fp) i =+ withForeignPtr fp $ \a -> peekElemOff a i++ unsafeWrite (StorableArray _ _ _ fp) i e =+ withForeignPtr fp $ \a -> pokeElemOff a i e++-- |The pointer to the array contents is obtained by 'withStorableArray'.+-- The idea is similar to 'ForeignPtr' (used internally here).+-- The pointer should be used only during execution of the 'IO' action+-- retured by the function passed as argument to 'withStorableArray'.+withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a+withStorableArray (StorableArray _ _ _ fp) f = withForeignPtr fp f++-- |If you want to use it afterwards, ensure that you+-- 'touchStorableArray' after the last use of the pointer,+-- so the array is not freed too early.+touchStorableArray :: StorableArray i e -> IO ()+touchStorableArray (StorableArray _ _ _ fp) = touchForeignPtr fp++-- |Construct a 'StorableArray' from an arbitrary 'ForeignPtr'. It is+-- the caller's responsibility to ensure that the 'ForeignPtr' points to+-- an area of memory sufficient for the specified bounds.+unsafeForeignPtrToStorableArray+ :: Ix i => ForeignPtr e -> (i,i) -> IO (StorableArray i e)+unsafeForeignPtrToStorableArray p (l,u) =+ return (StorableArray l u (rangeSize (l,u)) p)
+ Data/Array/Unboxed.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Array.Unboxed+-- 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)+--+-- Unboxed immutable arrays.+--+-----------------------------------------------------------------------------++module Data.Array.Unboxed (+ -- * Arrays with unboxed elements+ UArray,++ -- * The overloaded immutable array interface+ module Data.Array.IArray,+ ) where++import Prelude++import Data.Array.IArray+import Data.Array.Base
+ LICENSE view
@@ -0,0 +1,83 @@+This library (libraries/base) is derived from code from several+sources: ++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++ * Code from the Haskell Foreign Function Interface specification,+ which is (c) Manuel M. T. Chakravarty and freely redistributable+ (but see the full license for restrictions).++The full text of these licenses is reproduced below. All of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------++Code derived from the document "The Haskell 98 Foreign Function+Interface, An Addendum to the Haskell 98 Report" is distributed under+the following license:++ Copyright (c) 2002 Manuel M. T. Chakravarty++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Foreign Function Interface.++-----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ array.cabal view
@@ -0,0 +1,28 @@+name: array+version: 0.1.0.0+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+synopsis: Mutable and immutable arrays+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.+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+