{-# LANGUAGE BangPatterns, CPP, RankNTypes, MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, UnliftedFFITypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# OPTIONS_HADDOCK hide #-}
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(..), divInt# )
import GHC.Exts
import GHC.Ptr ( nullPtr, nullFunPtr )
import GHC.Stable ( StablePtr(..) )
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)
{-# INLINE safeRangeSize #-}
safeRangeSize :: Ix i => (i, i) -> Int
safeRangeSize (l,u) = let r = rangeSize (l, u)
in if r < 0 then error "Negative range size"
else r
{-# INLINE safeIndex #-}
safeIndex :: Ix i => (i, i) -> Int -> i -> Int
safeIndex (l,u) n i = let i' = 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 ++ ")")
{-# INLINE unsafeReplaceST #-}
unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)
unsafeReplaceST arr ies = do
marr <- thaw arr
sequence_ [unsafeWrite marr i e | (i, e) <- ies]
return marr
{-# INLINE unsafeAccumST #-}
unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)
unsafeAccumST f arr ies = do
marr <- thaw arr
sequence_ [do old <- unsafeRead marr i
unsafeWrite marr i (f old new)
| (i, new) <- ies]
return marr
{-# INLINE unsafeAccumArrayST #-}
unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)
unsafeAccumArrayST f e (l,u) ies = do
marr <- newArray (l,u) e
sequence_ [do old <- unsafeRead marr i
unsafeWrite marr i (f old new)
| (i, new) <- ies]
return marr
{-# INLINE array #-}
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]
{-# INLINE [1] listArray #-}
listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e
listArray (l,u) es =
let n = safeRangeSize (l,u)
in unsafeArray (l,u) (zip [0 .. n - 1] es)
{-# INLINE listArrayST #-}
listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)
listArrayST (l,u) es = do
marr <- newArray_ (l,u)
let n = safeRangeSize (l,u)
let fillFromList i xs | i == n = return ()
| otherwise = case xs of
[] -> return ()
y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
fillFromList 0 es
return marr
{-# RULES
"listArray/Array" listArray =
\lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray)
#-}
{-# INLINE listUArrayST #-}
listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)
=> (i,i) -> [e] -> ST s (STUArray s i e)
listUArrayST (l,u) es = do
marr <- newArray_ (l,u)
let n = safeRangeSize (l,u)
let fillFromList i xs | i == n = return ()
| otherwise = case xs of
[] -> return ()
y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
fillFromList 0 es
return marr
type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e
{-# RULES
"listArray/UArray/Bool" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool
"listArray/UArray/Char" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char
"listArray/UArray/Int" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int
"listArray/UArray/Word" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word
"listArray/UArray/Ptr" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a)
"listArray/UArray/FunPtr" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a)
"listArray/UArray/Float" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float
"listArray/UArray/Double" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double
"listArray/UArray/StablePtr" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a)
"listArray/UArray/Int8" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8
"listArray/UArray/Int16" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16
"listArray/UArray/Int32" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32
"listArray/UArray/Int64" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64
"listArray/UArray/Word8" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8
"listArray/UArray/Word16" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16
"listArray/UArray/Word32" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32
"listArray/UArray/Word64" listArray
= (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64
#-}
{-# INLINE (!) #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) arr i = case bounds arr of
(l,u) -> unsafeAt arr $ safeIndex (l,u) (numElements arr) i
{-# INLINE indices #-}
indices :: (IArray a e, Ix i) => a i e -> [i]
indices arr = case bounds arr of (l,u) -> range (l,u)
{-# INLINE elems #-}
elems :: (IArray a e, Ix i) => a i e -> [e]
elems arr = [unsafeAt arr i | i <- [0 .. numElements arr - 1]]
{-# INLINE assocs #-}
assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]
assocs arr = case bounds arr of
(l,u) -> [(i, arr ! i) | i <- range (l,u)]
{-# INLINE accumArray #-}
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]
{-# INLINE (//) #-}
(//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e
arr // ies = case bounds arr of
(l,u) -> unsafeReplace arr [ (safeIndex (l,u) (numElements arr) i, e)
| (i, e) <- ies]
{-# INLINE accum #-}
accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e
accum f arr ies = case bounds arr of
(l,u) -> let n = numElements arr
in unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]
{-# INLINE amap #-}
amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e
amap f arr = case bounds arr of
(l,u) -> let n = numElements arr
in unsafeArray (l,u) [ (i, f (unsafeAt arr i))
| i <- [0 .. n - 1]]
{-# INLINE ixmap #-}
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
{-# INLINE bounds #-}
bounds = Arr.bounds
{-# INLINE numElements #-}
numElements = Arr.numElements
{-# INLINE unsafeArray #-}
unsafeArray = Arr.unsafeArray
{-# INLINE unsafeAt #-}
unsafeAt = Arr.unsafeAt
{-# INLINE unsafeReplace #-}
unsafeReplace = Arr.unsafeReplace
{-# INLINE unsafeAccum #-}
unsafeAccum = Arr.unsafeAccum
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray = Arr.unsafeAccumArray
data UArray i e = UArray !i !i !Int ByteArray#
deriving Typeable
type role UArray nominal nominal
{-# INLINE unsafeArrayUArray #-}
unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
=> (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
unsafeArrayUArray (l,u) ies default_elem = do
marr <- newArray (l,u) default_elem
sequence_ [unsafeWrite marr i e | (i, e) <- ies]
unsafeFreezeSTUArray marr
{-# INLINE unsafeFreezeSTUArray #-}
unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
unsafeFreezeSTUArray (STUArray l u n marr#) = ST $ \s1# ->
case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, UArray l u n arr# #) }
{-# INLINE unsafeReplaceUArray #-}
unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
=> UArray i e -> [(Int, e)] -> ST s (UArray i e)
unsafeReplaceUArray arr ies = do
marr <- thawSTUArray arr
sequence_ [unsafeWrite marr i e | (i, e) <- ies]
unsafeFreezeSTUArray marr
{-# INLINE unsafeAccumUArray #-}
unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)
=> (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)
unsafeAccumUArray f arr ies = do
marr <- thawSTUArray arr
sequence_ [do old <- unsafeRead marr i
unsafeWrite marr i (f old new)
| (i, new) <- ies]
unsafeFreezeSTUArray marr
{-# INLINE unsafeAccumArrayUArray #-}
unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
=> (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)
unsafeAccumArrayUArray f 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
{-# INLINE eqUArray #-}
eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool
eqUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) =
if n1 == 0 then n2 == 0 else
l1 == l2 && u1 == u2 &&
and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]]
{-# INLINE [1] cmpUArray #-}
cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
{-# INLINE cmpIntUArray #-}
cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering
cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) =
if n1 == 0 then if n2 == 0 then EQ else LT else
if n2 == 0 then GT else
case compare l1 l2 of
EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1]
other -> other
where
cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
EQ -> rest
other -> other
{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
{-# SPECIALISE
showsIArray :: (IArray UArray e, Ix i, Show i, Show e) =>
Int -> UArray i e -> ShowS
#-}
showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS
showsIArray p a =
showParen (p > 9) $
showString "array " .
shows (bounds a) .
showChar ' ' .
shows (assocs a)
instance IArray UArray Bool where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = isTrue#
((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
`neWord#` int2Word# 0#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Char where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Int where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Word where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray (Ptr a) where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray (FunPtr a) where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Float where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Double where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray (StablePtr a) where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
nullStablePtr :: StablePtr a
nullStablePtr = StablePtr (unsafeCoerce# 0#)
instance IArray UArray Int8 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Int16 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Int32 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Int64 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Word8 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Word16 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Word32 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
instance IArray UArray Word64 where
{-# INLINE bounds #-}
bounds (UArray l u _ _) = (l,u)
{-# INLINE numElements #-}
numElements (UArray _ _ n _) = n
{-# INLINE unsafeArray #-}
unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
{-# INLINE unsafeAt #-}
unsafeAt (UArray _ _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
{-# INLINE unsafeReplace #-}
unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
{-# INLINE unsafeAccum #-}
unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
{-# INLINE unsafeAccumArray #-}
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
{-# NOINLINE arrEleBottom #-}
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 ()
{-# INLINE newArray #-}
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
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom
{-# INLINE newArray_ #-}
newArray_ (l,u) = newArray (l,u) arrEleBottom
instance MArray IOArray e IO where
{-# INLINE getBounds #-}
getBounds (IOArray marr) = stToIO $ getBounds marr
{-# INLINE getNumElements #-}
getNumElements (IOArray marr) = stToIO $ getNumElements marr
newArray = newIOArray
unsafeRead = unsafeReadIOArray
unsafeWrite = unsafeWriteIOArray
{-# INLINE newListArray #-}
newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
newListArray (l,u) es = do
marr <- newArray_ (l,u)
let n = safeRangeSize (l,u)
let fillFromList i xs | i == n = return ()
| otherwise = case xs of
[] -> return ()
y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
fillFromList 0 es
return marr
{-# INLINE readArray #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray marr i = do
(l,u) <- getBounds marr
n <- getNumElements marr
unsafeRead marr (safeIndex (l,u) n i)
{-# INLINE writeArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray marr i e = do
(l,u) <- getBounds marr
n <- getNumElements marr
unsafeWrite marr (safeIndex (l,u) n i) e
{-# INLINE getElems #-}
getElems :: (MArray a e m, Ix i) => a i e -> m [e]
getElems marr = do
(_l, _u) <- getBounds marr
n <- getNumElements marr
sequence [unsafeRead marr i | i <- [0 .. n - 1]]
{-# INLINE getAssocs #-}
getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
getAssocs marr = do
(l,u) <- getBounds marr
n <- getNumElements marr
sequence [ do e <- unsafeRead marr (safeIndex (l,u) n i); return (i,e)
| i <- range (l,u)]
{-# INLINE mapArray #-}
mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
mapArray f marr = do
(l,u) <- getBounds marr
n <- getNumElements marr
marr' <- newArray_ (l,u)
sequence_ [do e <- unsafeRead marr i
unsafeWrite marr' i (f e)
| i <- [0 .. n - 1]]
return marr'
{-# INLINE mapIndices #-}
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
{-# INLINE getBounds #-}
getBounds arr = return $! ArrST.boundsSTArray arr
{-# INLINE getNumElements #-}
getNumElements arr = return $! ArrST.numElementsSTArray arr
{-# INLINE newArray #-}
newArray = ArrST.newSTArray
{-# INLINE unsafeRead #-}
unsafeRead = ArrST.unsafeReadSTArray
{-# INLINE unsafeWrite #-}
unsafeWrite = ArrST.unsafeWriteSTArray
instance MArray (STArray s) e (Lazy.ST s) where
{-# INLINE getBounds #-}
getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)
{-# INLINE getNumElements #-}
getNumElements arr = strictToLazyST (return $! ArrST.numElementsSTArray arr)
{-# INLINE newArray #-}
newArray (l,u) e = strictToLazyST (ArrST.newSTArray (l,u) e)
{-# INLINE unsafeRead #-}
unsafeRead arr i = strictToLazyST (ArrST.unsafeReadSTArray arr i)
{-# INLINE unsafeWrite #-}
unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
data STUArray s i e = STUArray !i !i !Int (MutableByteArray# s)
deriving Typeable
type role STUArray nominal nominal nominal
instance Eq (STUArray s i e) where
STUArray _ _ _ arr1# == STUArray _ _ _ arr2# =
isTrue# (sameMutableByteArray# arr1# arr2#)
{-# INLINE unsafeNewArraySTUArray_ #-}
unsafeNewArraySTUArray_ :: Ix i
=> (i,i) -> (Int# -> Int#) -> ST s (STUArray s i e)
unsafeNewArraySTUArray_ (l,u) elemsToBytes
= case rangeSize (l,u) of
n@(I# n#) ->
ST $ \s1# ->
case newByteArray# (elemsToBytes n#) s1# of
(# s2#, marr# #) ->
(# s2#, STUArray l u n marr# #)
instance MArray (STUArray s) Bool (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE newArray #-}
newArray (l,u) initialValue = ST $ \s1# ->
case safeRangeSize (l,u) of { n@(I# n#) ->
case bOOL_SCALE n# of { nbytes# ->
case newByteArray# nbytes# s1# of { (# s2#, marr# #) ->
case setByteArray# marr# 0# nbytes# e# s2# of { s3# ->
(# s3#, STUArray l u n marr# #) }}}}
where
!(I# e#) = if initialValue then 0xff else 0x0
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds False
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
(# s2#, isTrue# ((e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0#) :: Bool #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->
case bOOL_INDEX i# of { j# ->
case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
case if e then old# `or#` bOOL_BIT i#
else old# `and#` bOOL_NOT_BIT i# of { e# ->
case writeWordArray# marr# j# e# s2# of { s3# ->
(# s3#, () #) }}}}
instance MArray (STUArray s) Char (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds (chr 0)
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, C# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
case writeWideCharArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Int (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, I# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
case writeIntArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Word (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, W# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
case writeWordArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) (Ptr a) (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds nullPtr
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, Ptr e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
case writeAddrArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) (FunPtr a) (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds nullFunPtr
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, FunPtr e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
case writeAddrArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Float (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) fLOAT_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, F# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
case writeFloatArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Double (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) dOUBLE_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, D# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
case writeDoubleArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) (StablePtr a) (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds (castPtrToStablePtr nullPtr)
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
(# s2# , StablePtr e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
case writeStablePtrArray# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Int8 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, I8# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
case writeInt8Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Int16 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 2#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, I16# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
case writeInt16Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Int32 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, I32# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
case writeInt32Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Int64 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 8#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, I64# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
case writeInt64Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Word8 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, W8# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
case writeWord8Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Word16 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 2#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, W16# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
case writeWord16Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Word32 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, W32# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
case writeWord32Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
instance MArray (STUArray s) Word64 (ST s) where
{-# INLINE getBounds #-}
getBounds (STUArray l u _ _) = return (l,u)
{-# INLINE getNumElements #-}
getNumElements (STUArray _ _ n _) = return n
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 8#)
{-# INLINE newArray_ #-}
newArray_ arrBounds = newArray arrBounds 0
{-# INLINE unsafeRead #-}
unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# ->
case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
(# s2#, W64# e# #) }
{-# INLINE unsafeWrite #-}
unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
case writeWord64Array# marr# i# e# s1# of { s2# ->
(# s2#, () #) }
bOOL_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
bOOL_SCALE n# =
(n# +# 7#) `uncheckedIShiftRA#` 3#
wORD_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSWORD
dOUBLE_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSDOUBLE
fLOAT_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSFLOAT
safe_scale :: Int# -> Int# -> Int#
safe_scale scale# n#
| not overflow = res#
| otherwise = error $ "Data.Array.Base.safe_scale: Overflow; scale: "
++ show (I# scale#) ++ ", n: " ++ show (I# n#)
where
!res# = scale# *# n#
!overflow = isTrue# (maxN# `divInt#` scale# <# n#)
!(I# maxN#) = maxBound
{-# INLINE safe_scale #-}
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)
{-# NOINLINE [1] freeze #-}
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)
{-# RULES
"freeze/STArray" freeze = ArrST.freezeSTArray
"freeze/STUArray" freeze = freezeSTUArray
#-}
{-# INLINE [1] unsafeFreeze #-}
unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
unsafeFreeze = freeze
{-# RULES
"unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray
"unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
#-}
thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
{-# NOINLINE [1] thaw #-}
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)
{-# RULES
"thaw/STArray" thaw = ArrST.thawSTArray
"thaw/STUArray" thaw = thawSTUArray
#-}
{-# INLINE [1] unsafeThaw #-}
unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
unsafeThaw = thaw
{-# INLINE unsafeThawSTUArray #-}
#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#))
{-# RULES
"unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray
"unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray
#-}
{-# INLINE unsafeThawIOArray #-}
#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)
{-# RULES
"unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray
#-}
#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)
{-# RULES
"thaw/IOArray" thaw = thawIOArray
#-}
#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)
{-# RULES
"freeze/IOArray" freeze = freezeIOArray
#-}
{-# INLINE unsafeFreezeIOArray #-}
#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)
{-# RULES
"unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray
#-}
castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray (STUArray l u n marr#) = return (STUArray l u n marr#)