packages feed

array-mhs (empty) → 0.5.8.0

raw patch · 19 files changed

+1950/−0 lines, 19 filesdep +base

Dependencies added: base

Files

+ Data/Array.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- 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 a more general interface+-- to immutable arrays: it defines operations with the same names as+-- those defined below, but with more general types, and also defines+-- 'Array' instances of the relevant classes.  To use that more general+-- 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+import Mhs.Array  -- Most of the hard work is done here++{- $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".+-}
+ Data/Array/Base.hs view
@@ -0,0 +1,827 @@+-- Copyright 2001 The University of Glasgow+-- Copyright 2023 Lennart Augustsson+-- See LICENSE file for full license.+module Data.Array.Base where+import Control.Monad.ST+import Data.Bits+import Data.Coerce+import Data.Int+import Data.Ix+import Data.Word+import Foreign.Ptr+import Foreign.StablePtr+import qualified Mhs.Array as Arr+import Mhs.MutUArr+import Mhs.UArr+import Text.Read(expectP, parens, Read(..))+import Text.Show(appPrec)+import Text.ParserCombinators.ReadPrec(prec, ReadPrec, step)+import Text.Read.Lex(Lexeme(Ident))+import Unsafe.Coerce++import Data.Array.IOArray+import Data.Array.STArray++--------------------------++class IArray a e where+  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)++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++safeIndex :: Ix i => (i, i) -> Int -> i -> Int+safeIndex (l,u) n i = let i' = index (l,u) i+                      in if (0 <= i') && (i' < n)+                         then i'+                         else error ("Error in array index; " ++ show i' +++                                     " not in range [0.." ++ show n ++ ")")++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++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++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++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]++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)++genArray :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e+genArray (l,u) f = listArray (l,u) $ map f $ range (l,u)++listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)+listArrayST = newListArray++listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)+             => (i,i) -> [e] -> ST s (STUArray s i e)+listUArrayST = newListArray++(!) :: (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++(!?) :: (IArray a e, Ix i) => a i e -> i -> Maybe e+(!?) arr i = let b = bounds arr in+             if inRange b i+             then Just $ unsafeAt arr $ unsafeIndex b i+             else Nothing++indices :: (IArray a e, Ix i) => a i e -> [i]+indices arr = case bounds arr of (l,u) -> range (l,u)++elems :: (IArray a e, Ix i) => a i e -> [e]+elems arr = [unsafeAt arr i | i <- [0 .. numElements arr - 1]]++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)]++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 initialValue (l,u) ies =+  let n = safeRangeSize (l, u)+  in unsafeAccumArray f initialValue (l,u)+                      [(safeIndex (l,u) n i, e) | (i, e) <- ies]++(//) :: (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]++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]++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]]++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)]++foldrArray :: (IArray a e, Ix i) => (e -> b -> b) -> b -> a i e -> b+foldrArray f z = \a ->+  let !n = numElements a+      go i | i >= n = z+           | otherwise = f (unsafeAt a i) (go (i+1))+  in go 0++foldlArray' :: (IArray a e, Ix i) => (b -> e -> b) -> b -> a i e -> b+foldlArray' f z0 = \a ->+  let !n = numElements a+      go !z i | i >= n = z+              | otherwise = go (f z (unsafeAt a i)) (i+1)+  in go z0 0++foldlArray :: (IArray a e, Ix i) => (b -> e -> b) -> b -> a i e -> b+foldlArray f z = \a ->+  let !n = numElements a+      go i | i < 0 = z+           | otherwise = f (go (i-1)) (unsafeAt a i)+  in go (n-1)++foldrArray' :: (IArray a e, Ix i) => (e -> b -> b) -> b -> a i e -> b+foldrArray' f z0 = \a ->+  let !n = numElements a+      go i !z | i < 0 = z+              | otherwise = go (i-1) (f (unsafeAt a i) z)+  in go (n-1) z0++traverseArray_+    :: (IArray a e, Ix i, Applicative f) => (e -> f b) -> a i e -> f ()+traverseArray_ f = foldrArray (\x z -> f x *> z) (pure ())++forArray_ :: (IArray a e, Ix i, Applicative f) => a i e -> (e -> f b) -> f ()+forArray_ = flip traverseArray_++foldlArrayM'+     :: (IArray a e, Ix i, Monad m) => (b -> e -> m b) -> b -> a i e -> m b+foldlArrayM' f z0 = \a ->+  let !n = numElements a+      go !z i | i >= n = pure z+              | otherwise = do+                  z' <- f z (unsafeAt a i)+                  go z' (i+1)+  in go z0 0++foldrArrayM'+    :: (IArray a e, Ix i, Monad m) => (e -> b -> m b) -> b -> a i e -> m b+foldrArrayM' f z0 = \a ->+  let !n = numElements a+      go i !z | i < 0 = pure z+              | otherwise = do+                  z' <- f (unsafeAt a i) z+                  go (i-1) z'+  in go (n-1) z0++instance IArray Arr.Array e where+  bounds           = Arr.bounds+  numElements      = Arr.numElements+  unsafeArray      = Arr.unsafeArray+  unsafeAt         = Arr.unsafeAt+  unsafeReplace    = Arr.unsafeReplace+  unsafeAccum      = Arr.unsafeAccum+--    unsafeAccumArray = Arr.unsafeAccumArray++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++unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)+unsafeFreezeSTUArray (STUArray lu n a) =+  UArray lu n <$> unsafeFreezeMutSTUArr a++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++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++unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)+                       => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)+unsafeAccumArrayUArray f initialValue (l,u) ies = do+  marr <- newArray (l,u) initialValue+  sequence_ [do old <- unsafeRead marr i+                unsafeWrite marr i (f old new)+            | (i, new) <- ies]+  unsafeFreezeSTUArray marr++eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool+eqUArray arr1@(UArray lu1 n1 _) arr2@(UArray lu2 n2 _) =+  if n1 == 0 then n2 == 0 else+  lu1 == lu2 &&+  and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]]++cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering+cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++-----------------------------------------------------------------------------+-- Showing and Reading IArrays++showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS+showsIArray p a =+  showParen (p > appPrec) $+  showString "array " .+  shows (bounds a) .+  showChar ' ' .+  shows (assocs a)++readIArray :: (IArray a e, Ix i, Read i, Read e) => ReadPrec (a i e)+readIArray = parens $ prec appPrec $+  do expectP (Ident "array")+     theBounds <- step readPrec+     vals   <- step readPrec+     return (array theBounds vals)++-----------------------------------------------------------------------------+-- Flat unboxed arrays: instances++data UArray i e = UArray (i, i) !Int (UArr e)++instance IArray UArray Bool where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)+  unsafeAt (UArray _ _ a) i = error "XXX unimplemented" -- unsafeReadUArr a q .&. 1++instance IArray UArray Char where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Int where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Word where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray (Ptr a) where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray (FunPtr a) where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies (castPtrToFunPtr nullPtr))+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Float where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Double where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray (StablePtr a) where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies (castPtrToStablePtr nullPtr))+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Int8 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Int16 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Int32 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Int64 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Word8 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Word16 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Word32 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance IArray UArray Word64 where+  bounds (UArray lu _ _) = lu+  numElements (UArray _ n _) = n+  unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)+  unsafeAt (UArray _ _ a) i = unsafeReadUArr a i+  unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)+  unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)+  unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)++instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where+  (==) = eqUArray++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++instance (Ix ix, Read ix, Read e, IArray UArray e) => Read (UArray ix e) where+  readPrec = readIArray++-----------------------------------------------------------------------------+-- Mutable arrays++arrEleBottom :: a+arrEleBottom = error "MArray: undefined array element"++class (Monad m) => MArray a e m where+  getBounds       :: Ix i => a i e -> m (i,i)+  getNumElements  :: Ix i => a i e -> m Int+  newArray        :: Ix i => (i,i) -> e -> m (a i e)+  newArray_       :: Ix i => (i,i) -> m (a i e)+  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 ()++  newArray (l,u) initialValue = do+      let n = safeRangeSize (l,u)+      marr <- unsafeNewArray_ (l,u)+      sequence_ [unsafeWrite marr i initialValue | i <- [0 .. n - 1]]+      return marr+  unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom+  newArray_ (l,u) = newArray (l,u) arrEleBottom++instance MArray IOArray e IO where+  getBounds   = return . boundsIOArray+  getNumElements = return . numElementsIOArray+  newArray    = newIOArray+  unsafeRead  = unsafeReadIOArray+  unsafeWrite = unsafeWriteIOArray++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)+      f x k i+          | i == n    = return ()+          | otherwise = unsafeWrite marr i x >> k (i+1)+  foldr f (\ !_i -> return ()) es 0+  -- The bang above is important for GHC for unbox the Int.+  return marr++newGenArray :: (MArray a e m, Ix i) => (i,i) -> (i -> m e) -> m (a i e)+newGenArray bnds f = do+  let n = safeRangeSize bnds+  marr <- unsafeNewArray_ bnds+  let g ix k i+          | i == n    = return ()+          | otherwise = do+              x <- f ix+              unsafeWrite marr i x+              k (i+1)+  foldr g (\ !_i -> return ()) (range bnds) 0+  -- The bang above is important for GHC for unbox the Int.+  return marr++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)++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++modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()+modifyArray marr i f = do+  (l,u) <- getBounds marr+  n <- getNumElements marr+  let idx = safeIndex (l,u) n i+  x <- unsafeRead marr idx+  unsafeWrite marr idx (f x)++modifyArray' :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()+modifyArray' marr i f = do+  (l,u) <- getBounds marr+  n <- getNumElements marr+  let idx = safeIndex (l,u) n i+  x <- unsafeRead marr idx+  let !x' = f x+  unsafeWrite marr idx x'++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]]++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)]++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'++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'++foldlMArray' :: (MArray a e m, Ix i) => (b -> e -> b) -> b -> a i e -> m b+foldlMArray' f = foldlMArrayM' (\z x -> pure (f z x))++foldrMArray' :: (MArray a e m, Ix i) => (e -> b -> b) -> b -> a i e -> m b+foldrMArray' f = foldrMArrayM' (\x z -> pure (f x z))++foldlMArrayM' :: (MArray a e m, Ix i) => (b -> e -> m b) -> b -> a i e -> m b+foldlMArrayM' f z0 = \a -> do+    !n <- getNumElements a+    let go !z i | i >= n = pure z+                | otherwise = do+                    x <- unsafeRead a i+                    z' <- f z x+                    go z' (i+1)+    go z0 0++foldrMArrayM' :: (MArray a e m, Ix i) => (e -> b -> m b) -> b -> a i e -> m b+foldrMArrayM' f z0 = \a -> do+    !n <- getNumElements a+    let go i !z | i < 0 = pure z+                | otherwise = do+                    x <- unsafeRead a i+                    z' <- f x z+                    go (i-1) z'+    go (n-1) z0++mapMArrayM_ :: (MArray a e m, Ix i) => (e -> m b) -> a i e -> m ()+mapMArrayM_ f = \a -> do+    !n <- getNumElements a+    let go i | i >= n = pure ()+             | otherwise = do+                 x <- unsafeRead a i+                 _ <- f x+                 go (i+1)+    go 0++forMArrayM_ :: (MArray a e m, Ix i) => a i e -> (e -> m b) -> m ()+forMArrayM_ = flip mapMArrayM_++-----------------------------------------------------------------------------+-- Polymorphic non-strict mutable arrays (ST monad)++instance MArray (STArray s) e (ST s) where+    getBounds      = return . boundsSTArray+    getNumElements = return . numElementsSTArray+    newArray       = newSTArray+    unsafeRead     = unsafeReadSTArray+    unsafeWrite    = unsafeWriteSTArray++{-+instance MArray (STArray s) e (Lazy.ST s) where+    getBounds arr       = strictToLazyST (return $! ArrST.boundsSTArray arr)+    getNumElements arr  = strictToLazyST (return $! ArrST.numElementsSTArray arr)+    newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)+    unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)+    unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)+-}++data STUArray s i e = STUArray (i,i) !Int (MutSTUArr s e)++instance Eq (STUArray s i e) where+  STUArray _ _ (MutSTUArr (MutIOUArr bs1)) == STUArray _ _ (MutSTUArr (MutIOUArr bs2)) =+    sameByteString bs1 bs2++instance MArray (STUArray s) Bool (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  newArray lu initialValue = STUArray lu n . cast <$> newMutSTUArrB (if initialValue then 0xff else 0) n'+    where n = safeRangeSize lu+          n' = (n `divUp` _wordSize) * (_wordSize `div` 8)+          cast :: MutSTUArr s Word8 -> MutSTUArr s Bool+          cast = coerce+  unsafeNewArray_ lu = STUArray lu n . cast <$> newMutSTUArr n'+    where n = safeRangeSize lu+          n' = n `divUp` _wordSize+          cast :: MutSTUArr s Word -> MutSTUArr s Bool+          cast = coerce+  newArray_ arrBounds = newArray arrBounds False+  unsafeRead (STUArray _ _ a) i = do+    let (q, r) = quotRem i _wordSize+        cast :: MutSTUArr s Bool -> MutSTUArr s Word+        cast = coerce+    w <- unsafeReadMutSTUArr (cast a) q+    return $! (w .&. (1 `unsafeShiftL` r)) /= 0+  unsafeWrite (STUArray _ _ a) i e = do+    let (q, r) = quotRem i _wordSize+        cast :: MutSTUArr s Bool -> MutSTUArr s Word+        cast = coerce+    w <- unsafeReadMutSTUArr (cast a) q+    let w' = if e then w .|. b else w .&. complement b+        b = 1 `unsafeShiftL` r+    unsafeWriteMutSTUArr (cast a) q w'++divUp :: Int -> Int -> Int+divUp x y = (x + (y-1)) `quot` y++instance MArray (STUArray s) Char (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu '\0'+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Int (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Word (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) (Ptr a) (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu nullPtr+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) (FunPtr a) (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu nullFunPtr+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Float (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Double (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) (StablePtr a) (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu (castPtrToStablePtr nullPtr)+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Int8 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Int16 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Int32 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Int64 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Word8 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Word16 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Word32 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++instance MArray (STUArray s) Word64 (ST s) where+  getBounds (STUArray lu _ _) = return lu+  getNumElements (STUArray _ n _) = return n+  unsafeNewArray_ lu = STUArray lu n <$> newMutSTUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (STUArray _ _ a) i = unsafeReadMutSTUArr a i+  unsafeWrite (STUArray _ _ a) i e = unsafeWriteMutSTUArr a i e++-----------------------------------------------------------------------------+-- 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+  es <- mapM (unsafeRead marr) [0 .. n - 1]+  -- The old array and index might not be well-behaved, so we need to+  -- use the safe array creation function here.+  return (listArray (l,u) es)++freezeSTUArray :: STUArray s i e -> ST s (UArray i e)+freezeSTUArray (STUArray lu n a) = UArray lu n . copyUArr <$> unsafeFreezeMutSTUArr a++unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+unsafeFreeze = freeze++-----------------------------------------------------------------------------+-- Thawing++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++thawSTUArray :: UArray i e -> ST s (STUArray s i e)+thawSTUArray (UArray lu n a) = STUArray lu n <$> unsafeThawSTUArr (copyUArr a)++unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+unsafeThaw = thaw++-- | Casts an 'STUArray' with one element type into one with a+-- different element type.  All the elements of the resulting array+-- are undefined (unless you know what you\'re doing...).++castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)+castSTUArray a = return (unsafeCoerce a)
+ Data/Array/IArray.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- 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" module. Other packages, such as+-- diffarray, also provide arrays using this interface.+--+-----------------------------------------------------------------------------++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+    genArray,   -- :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e++    -- * Accessing arrays+    (!),        -- :: (IArray a e, Ix i) => a i e -> i -> e+    (!?),       -- :: (IArray a e, Ix i) => a i e -> i -> Maybe 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)]++    -- * Array folds+    foldrArray,+    foldlArray',+    foldlArray,+    foldrArray',+    traverseArray_,+    forArray_,+    foldlArrayM',+    foldrArrayM',++    -- * 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 Data.Ix+import Data.Array(Array)+import Data.Array.Base
+ Data/Array/IO.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE MagicHash, Trustworthy, UnliftedFFITypes #-}++-----------------------------------------------------------------------------+-- |+-- 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++    -- * 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 Data.Array.Base+import Data.Array.IOArray+import Data.Array.IO.Internals+import Data.Array.MArray+import Foreign+import Foreign.C+import Mhs.MutUArr(withMutIOUArr)+import System.IO+import System.IO.Error++-- ---------------------------------------------------------------------------+-- 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 _lu n arr) count+  | count == 0              = return 0+  | count < 0 || count > n  = illegalBufferSize handle "hGetArray" count+  | otherwise = withMutIOUArr arr $ \ p -> hGetBuf handle p count+++-- ---------------------------------------------------------------------------+-- 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 _lu n arr) count+  | count == 0              = return ()+  | count < 0 || count > n  = illegalBufferSize handle "hPutArray" count+  | otherwise = withMutIOUArr arr $ \ p -> hPutBuf handle p count++-- ---------------------------------------------------------------------------+-- Internal Utils++illegalBufferSize :: Handle -> String -> Int -> IO a+illegalBufferSize handle fn sz =+        ioException (ioeSetErrorString+                     (mkIOError InvalidArgument fn (Just handle) Nothing)+                     ("illegal buffer size " ++ showsPrec 9 (sz::Int) []))
+ Data/Array/IO/Internals.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE+    FlexibleInstances+  , MultiParamTypeClasses+  , RoleAnnotations+ #-}++{-# OPTIONS_HADDOCK not-home #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.IO.Internal+-- Copyright   :  (c) The University of Glasgow 2001-2012+-- 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.+--+-- = WARNING+--+-- This module is considered __internal__.+--+-- The Package Versioning Policy __does not apply__.+--+-- The contents of this module may change __in any way whatsoever__+-- and __without any warning__ between minor versions of this package.+--+-- Authors importing this module are expected to track development+-- closely.+--+-----------------------------------------------------------------------------++module Data.Array.IO.Internals (+    IOArray(..),         -- instance of: Eq, Typeable+    IOUArray(..),        -- instance of: Eq, Typeable+    castIOUArray,        -- :: IOUArray ix a -> IO (IOUArray ix b)+    unsafeThawIOUArray,+    unsafeFreezeIOUArray+  ) where+import Data.Bits+import Data.Coerce+import Data.Int+import Data.Word+import Foreign.Ptr+import Foreign.StablePtr+import Data.Array.Base+import Mhs.MutUArr+import Mhs.UArr+import Unsafe.Coerce+import Data.Array.IOArray++data IOUArray i e = IOUArray (i,i) !Int (MutIOUArr e)++{-+instance Eq (IOUArray i e) where+    IOUArray s1 == IOUArray s2  =  s1 == s2+-}++instance MArray IOUArray Bool IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  newArray lu initialValue = IOUArray lu n . cast <$> newMutIOUArrB (if initialValue then 0xff else 0) n'+    where n = safeRangeSize lu+          n' = (n `divUp` _wordSize) * (_wordSize `div` 8)+          cast :: MutIOUArr Word8 -> MutIOUArr Bool+          cast = coerce+  unsafeNewArray_ lu = IOUArray lu n . cast <$> newMutIOUArr n'+    where n = safeRangeSize lu+          n' = n `divUp` _wordSize+          cast :: MutIOUArr Word -> MutIOUArr Bool+          cast = coerce+  newArray_ arrBounds = newArray arrBounds False+  unsafeRead (IOUArray _ _ a) i = do+    let (q, r) = quotRem i _wordSize+        cast :: MutIOUArr Bool -> MutIOUArr Word+        cast = coerce+    w <- unsafeReadMutIOUArr (cast a) q+    return $! (w .&. (1 `unsafeShiftL` r)) /= 0+  unsafeWrite (IOUArray _ _ a) i e = do+    let (q, r) = quotRem i _wordSize+        cast :: MutIOUArr Bool -> MutIOUArr Word+        cast = coerce+    w <- unsafeReadMutIOUArr (cast a) q+    let w' = if e then w .|. b else w .&. complement b+        b = 1 `unsafeShiftL` r+    unsafeWriteMutIOUArr (cast a) q w'++instance MArray IOUArray Char IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu '\0'+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Int IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Word IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray (Ptr a) IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu nullPtr+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray (FunPtr a) IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu (castPtrToFunPtr nullPtr)+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Float IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Double IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray (StablePtr a) IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu (castPtrToStablePtr nullPtr)+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Int8 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Int16 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Int32 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Int64 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Word8 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Word16 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Word32 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a i e++instance MArray IOUArray Word64 IO where+  getBounds (IOUArray lu _ _) = return lu+  getNumElements (IOUArray _ n _) = return n+  unsafeNewArray_ lu = IOUArray lu n <$> newMutIOUArr n where n = safeRangeSize lu+  newArray_ lu = newArray lu 0+  unsafeRead (IOUArray _ _ a) i = unsafeReadMutIOUArr a i+  unsafeWrite (IOUArray _ _ a) i e = unsafeWriteMutIOUArr a 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 a = return (unsafeCoerce a)++unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e)+unsafeThawIOUArray (UArray lu n a) = IOUArray lu n <$> unsafeThawIOUArr a++thawIOUArray :: UArray ix e -> IO (IOUArray ix e)+thawIOUArray (UArray lu n a) = IOUArray lu n <$> unsafeThawIOUArr (copyUArr a)++unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e)+unsafeFreezeIOUArray (IOUArray lu n a) = UArray lu n <$> unsafeFreezeMutIOUArr a++freezeIOUArray :: IOUArray ix e -> IO (UArray ix e)+freezeIOUArray (IOUArray lu n a) = UArray lu n . copyUArr <$> unsafeFreezeMutIOUArr a
+ Data/Array/IO/Safe.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.IO.Safe+-- 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.+-- .+-- Safe API only of "Data.Array.IO".+--+-- @since 0.4.0.0+-----------------------------------------------------------------------------++module Data.Array.IO.Safe (+    -- * @IO@ arrays with boxed elements+    IOArray,             -- instance of: Eq, Typeable++    -- * @IO@ arrays with unboxed elements+    IOUArray,            -- instance of: Eq, Typeable++    -- * Overloaded mutable array interface+    module Data.Array.MArray.Safe,++    -- * Doing I\/O with @IOUArray@s+    hGetArray,           -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int+    hPutArray,           -- :: Handle -> IOUArray Int Word8 -> Int -> IO ()+  ) where++import Data.Array.IO+import Data.Array.MArray.Safe
+ Data/Array/IOArray.hs view
@@ -0,0 +1,61 @@+module Data.Array.IOArray(+  IOArray(..),+  newIOArray,+  boundsIOArray,+  numElementsIOArray,+  readIOArray,+  writeIOArray,+  freezeIOArray,+  thawIOArray,+  unsafeReadIOArray,+  unsafeWriteIOArray,+  unsafeFreezeIOArray,+  unsafeThawIOArray,+  ) where+import Control.Monad.ST+import Control.Monad.ST_Type+import Data.Ix+import Mhs.Array+import Mhs.MutArr++data IOArray i a+   = IOArray (i, i)          -- bounds+             !Int            -- = rangeSize (l, u)+             (MutIOArr a)    -- elements++newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)+newIOArray lu a = IOArray lu n <$> newMutIOArr n a+  where n = safeRangeSize lu++boundsIOArray :: IOArray i e -> (i,i)+boundsIOArray (IOArray lu _ _) = lu++numElementsIOArray :: IOArray i e -> Int+numElementsIOArray (IOArray _ n _) = n++readIOArray :: Ix i => IOArray i e -> i -> IO e+readIOArray arr@(IOArray lu n _) i = unsafeReadIOArray arr (safeIndex lu n i)++unsafeReadIOArray :: IOArray i e -> Int -> IO e+unsafeReadIOArray (IOArray _ _ arr) i = unsafeReadMutIOArr arr i++writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()+writeIOArray arr@(IOArray lu n _) i e = unsafeWriteIOArray arr (safeIndex lu n i) e++unsafeWriteIOArray :: IOArray i e -> Int -> e -> IO ()+unsafeWriteIOArray (IOArray _ _ arr) i e = unsafeWriteMutIOArr arr i e++----------------------------------------------------------------------+-- Moving between mutable and immutable++freezeIOArray :: IOArray i e -> IO (Array i e)+freezeIOArray (IOArray lu n arr) = Array lu n <$> copyMutIOArr arr++unsafeFreezeIOArray :: IOArray i e -> IO (Array i e)+unsafeFreezeIOArray (IOArray lu n arr) = return $ Array lu n arr++thawIOArray :: Array i e -> IO (IOArray i e)+thawIOArray (Array lu n arr) = IOArray lu n <$> copyMutIOArr arr++unsafeThawIOArray :: Array i e -> IO (IOArray i e)+unsafeThawIOArray (Array lu n arr) = return $ IOArray lu n arr
+ Data/Array/MArray.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE CPP, Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- 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)+    newGenArray,  -- :: (MArray a e m, Ix i) => (i,i) -> (i -> m 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 ()+    modifyArray,+    modifyArray',++    -- * Array folds+    foldlMArray',+    foldrMArray',+    mapMArrayM_,+    forMArrayM_,+    foldlMArrayM',+    foldrMArrayM',++    -- * 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)+    thaw,         -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+  ) where++import Data.Ix+import Data.Array.Base
+ Data/Array/MArray/Safe.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE CPP, Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.MArray.Safe+-- 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".+-- .+-- Safe API only of "Data.Array.MArray".+--+-- @since 0.4.0.0+-----------------------------------------------------------------------------++module Data.Array.MArray.Safe (+    -- * 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)+    newGenArray,  -- :: (MArray a e m, Ix i) => (i,i) -> (i -> m 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 ()++    -- * Array folds+    foldlMArray',+    foldrMArray',+    mapMArrayM_,+    forMArrayM_,+    foldlMArrayM',+    foldrMArrayM',++    -- * 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)+    thaw,         -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)+  ) where++import Data.Ix+import Data.Array.Base+#ifdef __HADDOCK__+import Data.Array.IArray+#endif+
+ Data/Array/ST.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE RankNTypes, Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- 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,++   -- * Overloaded mutable array interface+   module Data.Array.MArray,+ ) where++import Data.Array.Base  ( STUArray, UArray, unsafeFreezeSTUArray )+import Data.Array.MArray+import Control.Monad.ST ( ST, runST )++import Mhs.Array(Array)+import Data.Array.STArray(STArray, unsafeFreezeSTArray)++-- | 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 :: (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 :: (forall s . ST s (STUArray s i e)) -> UArray i e+runSTUArray st = runST (st >>= unsafeFreezeSTUArray)+++-- INTERESTING... this is the type we'd like to give to runSTUArray:+--+-- runSTUArray :: (Ix i, IArray UArray e,+--              forall s. MArray (STUArray s) e (ST s))+--         => (forall s . ST s (STUArray s i e))+--         -> UArray i e+--+-- Note the quantified constraint.  We dodged the problem by using+-- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but+-- this essentially constrains us to a single unsafeFreeze for all STUArrays+-- (in theory we might have a different one for certain element types).
+ Data/Array/ST/Safe.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.ST.Safe+-- Copyright   :  (c) The University of Glasgow 2011+-- 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.+--+-- Safe API only of "Data.Array.ST".+--+-- @since 0.4.0.0+-----------------------------------------------------------------------------++module Data.Array.ST.Safe (+   -- * Boxed arrays+   STArray,             -- instance of: Eq, MArray+   runSTArray,++   -- * Unboxed arrays+   STUArray,            -- instance of: Eq, MArray+   runSTUArray,++   -- * Overloaded mutable array interface+   module Data.Array.MArray.Safe,+ ) where++import Data.Array.ST+import Data.Array.MArray.Safe+
+ Data/Array/STArray.hs view
@@ -0,0 +1,56 @@+module Data.Array.STArray(+  STArray(..),+  newSTArray,+  boundsSTArray,+  numElementsSTArray,+  readSTArray,+  writeSTArray,+  freezeSTArray,+  thawSTArray,+  unsafeReadSTArray,+  unsafeWriteSTArray,+  unsafeFreezeSTArray,+  unsafeThawSTArray,+  ) where+import Control.Monad.ST+import Control.Monad.ST_Type+import Mhs.Array+import Data.Array.IOArray++newtype STArray s i a = STArray (IOArray i a)++newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)+newSTArray lu e = ST (STArray <$> newIOArray lu e)++boundsSTArray :: STArray s i e -> (i,i)+boundsSTArray (STArray a) = boundsIOArray a++numElementsSTArray :: forall s i e . STArray s i e -> Int+numElementsSTArray (STArray a) = numElementsIOArray a++readSTArray :: Ix i => STArray s i e -> i -> ST s e+readSTArray (STArray a) i = ST (readIOArray a i)++unsafeReadSTArray :: STArray s i e -> Int -> ST s e+unsafeReadSTArray (STArray a) i = ST (unsafeReadIOArray a i)++writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()+writeSTArray (STArray a) i e = ST (writeIOArray a i e)++unsafeWriteSTArray :: STArray s i e -> Int -> e -> ST s ()+unsafeWriteSTArray (STArray a) i e = ST (unsafeWriteIOArray a i e)++----------------------------------------------------------------------+-- Moving between mutable and immutable++freezeSTArray :: STArray s i e -> ST s (Array i e)+freezeSTArray (STArray a) = ST (freezeIOArray a)++unsafeFreezeSTArray :: STArray s i e -> ST s (Array i e)+unsafeFreezeSTArray (STArray a) = ST (unsafeFreezeIOArray a)++thawSTArray :: Array i e -> ST s (STArray s i e)+thawSTArray a = ST (STArray <$> thawIOArray a)++unsafeThawSTArray :: Array i e -> ST s (STArray s i e)+unsafeThawSTArray a = ST (STArray <$> unsafeThawIOArray a)
+ Data/Array/Storable.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- 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 ()+  ) where++import Data.Array.MArray+import Data.Array.Storable.Internals
+ Data/Array/Storable/Internals.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RoleAnnotations #-}+{-# OPTIONS_HADDOCK not-home #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.Storable.Internals+-- Copyright   :  (c) The University of Glasgow 2011+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (uses Data.Array.MArray)+--+-- Actual implementation of "Data.Array.Storable".+--+-- @since 0.4.0.0+--+-- = WARNING+--+-- This module is considered __internal__.+--+-- The Package Versioning Policy __does not apply__.+--+-- The contents of this module may change __in any way whatsoever__+-- and __without any warning__ between minor versions of this package.+--+-- Authors importing this module are expected to track development+-- closely.+-----------------------------------------------------------------------------++module Data.Array.Storable.Internals (+    StorableArray(..),+    withStorableArray,+    touchStorableArray,+    unsafeForeignPtrToStorableArray,+  ) where++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)+-- Both parameters have class-based invariants. See also #9220.+-- type role StorableArray nominal nominal++instance Storable e => MArray StorableArray e IO where+    getBounds (StorableArray lu _ _) = return lu++    getNumElements (StorableArray _lu n _) = return n++    newArray lu initialValue = do+        fp <- mallocForeignPtrArray size+        withForeignPtr fp $ \a ->+            sequence_ [pokeElemOff a i initialValue | i <- [0..size-1]]+        return (StorableArray lu size fp)+        where+        size = rangeSize lu++    unsafeNewArray_ lu = do+        let n = rangeSize lu+        fp <- mallocForeignPtrArray n+        return (StorableArray lu 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 lu =+   return (StorableArray lu (rangeSize lu) p)
+ Data/Array/Storable/Safe.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.Storable.Safe+-- 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.+--+-- Safe API only of "Data.Array.Storable".+--+-- @since 0.4.0.0+-----------------------------------------------------------------------------++module Data.Array.Storable.Safe (+    -- * 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.Safe,++    -- * Accessing the pointer to the array contents+    withStorableArray,  -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a++    touchStorableArray, -- :: StorableArray i e -> IO ()+  ) where++import Data.Array.MArray.Safe+import Data.Array.Storable.Internals+
+ Data/Array/Unboxed.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- 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 Data.Array.Base+import Data.Array.IArray+
+ Data/Array/Unsafe.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.Unsafe+-- Copyright   :  (c) The University of Glasgow 2011+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (uses Data.Array.MArray)+--+-- Contains the various unsafe operations that can be performed+-- on arrays.+--+-- @since 0.4.0.0+-----------------------------------------------------------------------------++module Data.Array.Unsafe (+    -- * Unsafe operations+    castSTUArray,  -- :: STUArray s i a -> ST s (STUArray s i b)+    castIOUArray,  -- :: IOUArray i a -> IO (IOUArray i b)++    unsafeFreeze,  -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)+    unsafeThaw,    -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)++    unsafeForeignPtrToStorableArray -- :: Ix i => ForeignPtr e -> (i,i)+                                    --         -> IO (StorableArray i e)+  ) where+++import Data.Array.Base ( castSTUArray, unsafeFreeze, unsafeThaw )+import Data.Array.IO.Internals ( castIOUArray )+import Data.Array.Storable.Internals ( unsafeForeignPtrToStorableArray )+
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright 2023,2024,2025 Lennart Augustsson++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ array-mhs.cabal view
@@ -0,0 +1,47 @@+cabal-version: >= 1.10+name:          array-mhs+version:       0.5.8.0+license:       Apache-2.0+license-file:  LICENSE+copyright:     2025 Lennart Augustsson+maintainer:    lennart@augustsson.net+bug-reports:   https://github.com/augustss/array-mhs/issues+synopsis:      Mutable and immutable arrays+category:      Data Structures+build-type:    Simple+description:+    This is a copy of the array package adapted for MicroHs.+    .+    In addition to providing the "Data.Array" module+    <http://www.haskell.org/onlinereport/haskell2010/haskellch14.html as specified in the Haskell 2010 Language Report>,+    this package also defines the classes 'IArray' of+    immutable arrays and 'MArray' of arrays mutable within appropriate+    monads, as well as some instances of these classes.++source-repository head+  type:     git+  location: https://github.com/augustss/array-mhs.git++library+  default-language: Haskell2010+  build-depends:+      base >= 4.5 && < 5+  exposed-modules:+      Data.Array+      Data.Array.Base+      Data.Array.IArray+      Data.Array.IO+      Data.Array.IO.Safe+      Data.Array.IO.Internals+      Data.Array.MArray+      Data.Array.MArray.Safe+      Data.Array.ST+      Data.Array.ST.Safe+      Data.Array.Storable+      Data.Array.Storable.Safe+      Data.Array.Storable.Internals+      Data.Array.Unboxed+      Data.Array.Unsafe+  other-modules:+      Data.Array.IOArray+      Data.Array.STArray