#if __GLASGOW_HASKELL__ >= 708
#endif
module Data.Array.Base where
import Control.Monad.ST.Lazy ( strictToLazyST )
import qualified Control.Monad.ST.Lazy as Lazy (ST)
import Data.Ix ( Ix, range, index, rangeSize )
import Foreign.C.Types
import Foreign.StablePtr
import Data.Char
import GHC.Arr          ( STArray )
import qualified GHC.Arr as Arr
import qualified GHC.Arr as ArrST
import GHC.ST           ( ST(..), runST )
import GHC.Base         ( IO(..) )
import GHC.Exts
import GHC.Ptr          ( nullPtr, nullFunPtr )
import GHC.Stable       ( StablePtr(..) )
#if !MIN_VERSION_base(4,6,0)
import GHC.Exts         ( Word(..) )
#endif
import GHC.Int          ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )
import GHC.Word         ( Word8(..), Word16(..), Word32(..), Word64(..) )
import GHC.IO           ( stToIO )
import GHC.IOArray      ( IOArray(..),
                          newIOArray, unsafeReadIOArray, unsafeWriteIOArray )
import Data.Typeable
#include "MachDeps.h"
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)        
        -> [(i, e)]     
        -> 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)
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
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
type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e
(!) :: (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
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 = case bounds arr of
    (_l, _u) -> [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)     
           -> e                  
           -> (i,i)              
           -> [(i, e')]          
           -> a i e              
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)]
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
data UArray i e = UArray !i !i !Int ByteArray#
                  deriving Typeable
#if __GLASGOW_HASKELL__ >= 708
type role UArray nominal nominal
#endif
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 l u n marr#) = ST $ \s1# ->
    case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
    (# s2#, UArray l u n arr# #) }
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 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]]
cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
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
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)
instance IArray UArray Bool where
    
    bounds (UArray l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
    
#if __GLASGOW_HASKELL__ > 706
    unsafeAt (UArray _ _ _ arr#) (I# i#) = isTrue#
#else
    unsafeAt (UArray _ _ _ arr#) (I# i#) =
#endif
        ((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
        `neWord#` int2Word# 0#)
    
    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 Char where
    
    bounds (UArray l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = I# (indexIntArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = W# (indexWordArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = F# (indexFloatArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# 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)
nullStablePtr :: StablePtr a
nullStablePtr = StablePtr (unsafeCoerce# 0#)
instance IArray UArray Int8 where
    
    bounds (UArray l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# 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 l u _ _) = (l,u)
    
    numElements (UArray _ _ n _) = n
    
    unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
    
    unsafeAt (UArray _ _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# 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
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 (IOArray marr) = stToIO $ getBounds marr
    
    getNumElements (IOArray marr) = stToIO $ getNumElements marr
    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)
    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
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
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'
instance MArray (STArray s) e (ST s) where
    
    getBounds arr = return $! ArrST.boundsSTArray arr
    
    getNumElements arr = return $! ArrST.numElementsSTArray arr
    
    newArray    = ArrST.newSTArray
    
    unsafeRead  = ArrST.unsafeReadSTArray
    
    unsafeWrite = ArrST.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 (MutableByteArray# s)
                      deriving Typeable
#if __GLASGOW_HASKELL__ >= 708
type role STUArray nominal nominal nominal
#endif
instance Eq (STUArray s i e) where
    STUArray _ _ _ arr1# == STUArray _ _ _ arr2# =
#if __GLASGOW_HASKELL__ > 706
        isTrue# (sameMutableByteArray# arr1# arr2#)
#else
        sameMutableByteArray# arr1# arr2#
#endif
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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    newArray (l,u) initialValue = ST $ \s1# ->
        case safeRangeSize (l,u)            of { n@(I# n#) ->
        case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
        case bOOL_WORD_SCALE n#         of { n'# ->
#if __GLASGOW_HASKELL__ > 706
        let loop i# s3# | isTrue# (i# ==# n'#) = s3#
#else
        let loop i# s3# | i# ==# n'#           = s3#
#endif
                        | 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 initialValue then maxBound else 0
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE
    
    newArray_ arrBounds = newArray arrBounds False
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
#if __GLASGOW_HASKELL__ > 706
        (# s2#, isTrue# ((e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0#) :: Bool #) }
#else
        (# s2#, (e# `and#` bOOL_BIT i# `neWord#` int2Word# 0#) :: Bool #) }
#endif
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#)
    
    newArray_ arrBounds = newArray arrBounds (chr 0)
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, C# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, I# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, W# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
    
    newArray_ arrBounds = newArray arrBounds nullPtr
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, Ptr e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
    
    newArray_ arrBounds = newArray arrBounds nullFunPtr
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, FunPtr e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) fLOAT_SCALE
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, F# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) dOUBLE_SCALE
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, D# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
    
    newArray_ arrBounds = newArray arrBounds (castPtrToStablePtr nullPtr)
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
        (# s2# , StablePtr e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, I8# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 2#)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, I16# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, I32# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 8#)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, I64# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, W8# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 2#)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, W16# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 4#)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, W32# e# #) }
    
    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
    
    getBounds (STUArray l u _ _) = return (l,u)
    
    getNumElements (STUArray _ _ n _) = return n
    
    unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (*# 8#)
    
    newArray_ arrBounds = newArray arrBounds 0
    
    unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
        case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
        (# s2#, W64# e# #) }
    
    unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
        case writeWord64Array# marr# i# e# s1# of { s2# ->
        (# s2#, () #) }
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
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]
  
  
  return (listArray (l,u) es)
#if __GLASGOW_HASKELL__ >= 711
freezeSTUArray :: STUArray s i e -> ST s (UArray i e)
#else
freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
#endif
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)
unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
unsafeFreeze = freeze
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
#if __GLASGOW_HASKELL__ >= 711
thawSTUArray :: UArray i e -> ST s (STUArray s i e)
#else
thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
#endif
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)
unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
unsafeThaw = thaw
#if __GLASGOW_HASKELL__ >= 711
unsafeThawSTUArray :: UArray i e -> ST s (STUArray s i e)
#else
unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
#endif
unsafeThawSTUArray (UArray l u n marr#) =
    return (STUArray l u n (unsafeCoerce# marr#))
#if __GLASGOW_HASKELL__ >= 711
unsafeThawIOArray :: Arr.Array ix e -> IO (IOArray ix e)
#else
unsafeThawIOArray :: Ix ix => Arr.Array ix e -> IO (IOArray ix e)
#endif
unsafeThawIOArray arr = stToIO $ do
    marr <- ArrST.unsafeThawSTArray arr
    return (IOArray marr)
#if __GLASGOW_HASKELL__ >= 711
thawIOArray :: Arr.Array ix e -> IO (IOArray ix e)
#else
thawIOArray :: Ix ix => Arr.Array ix e -> IO (IOArray ix e)
#endif
thawIOArray arr = stToIO $ do
    marr <- ArrST.thawSTArray arr
    return (IOArray marr)
#if __GLASGOW_HASKELL__ >= 711
freezeIOArray :: IOArray ix e -> IO (Arr.Array ix e)
#else
freezeIOArray :: Ix ix => IOArray ix e -> IO (Arr.Array ix e)
#endif
freezeIOArray (IOArray marr) = stToIO (ArrST.freezeSTArray marr)
#if __GLASGOW_HASKELL__ >= 711
unsafeFreezeIOArray :: IOArray ix e -> IO (Arr.Array ix e)
#else
unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Arr.Array ix e)
#endif
unsafeFreezeIOArray (IOArray marr) = stToIO (ArrST.unsafeFreezeSTArray marr)
castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray (STUArray l u n marr#) = return (STUArray l u n marr#)