diff --git a/Data/Array.hs b/Data/Array.hs new file mode 100644 --- /dev/null +++ b/Data/Array.hs @@ -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 diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Base.hs @@ -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 diff --git a/Data/Array/Diff.hs b/Data/Array/Diff.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Diff.hs @@ -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 + #-} diff --git a/Data/Array/IArray.hs b/Data/Array/IArray.hs new file mode 100644 --- /dev/null +++ b/Data/Array/IArray.hs @@ -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 diff --git a/Data/Array/IO.hs b/Data/Array/IO.hs new file mode 100644 --- /dev/null +++ b/Data/Array/IO.hs @@ -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__ */ diff --git a/Data/Array/IO/Internals.hs b/Data/Array/IO/Internals.hs new file mode 100644 --- /dev/null +++ b/Data/Array/IO/Internals.hs @@ -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') + diff --git a/Data/Array/MArray.hs b/Data/Array/MArray.hs new file mode 100644 --- /dev/null +++ b/Data/Array/MArray.hs @@ -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 diff --git a/Data/Array/ST.hs b/Data/Array/ST.hs new file mode 100644 --- /dev/null +++ b/Data/Array/ST.hs @@ -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). diff --git a/Data/Array/Storable.hs b/Data/Array/Storable.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Storable.hs @@ -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) diff --git a/Data/Array/Unboxed.hs b/Data/Array/Unboxed.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Unboxed.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + +----------------------------------------------------------------------------- diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/array.cabal b/array.cabal new file mode 100644 --- /dev/null +++ b/array.cabal @@ -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 +