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
import GHC.Ptr ( Ptr(..), FunPtr(..), 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
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
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)
freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
freezeSTUArray (STUArray l u n marr#) = ST $ \s1# ->
case sizeofMutableByteArray# marr# of { n# ->
case newByteArray# n# s1# of { (# s2#, marr'# #) ->
case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->
case unsafeCoerce# m s2# of { (# s3#, _ #) ->
case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
(# s4#, UArray l u n arr# #) }}}}}
foreign import ccall unsafe "memcpy"
memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize
-> IO (Ptr a)
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
thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
thawSTUArray (UArray l u n arr#) = ST $ \s1# ->
case sizeofByteArray# arr# of { n# ->
case newByteArray# n# s1# of { (# s2#, marr# #) ->
case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->
case unsafeCoerce# m s2# of { (# s3#, _ #) ->
(# s3#, STUArray l u n marr# #) }}}}
foreign import ccall unsafe "memcpy"
memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize
-> IO (Ptr a)
unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
unsafeThaw = thaw
unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
unsafeThawSTUArray (UArray l u n marr#) =
return (STUArray l u n (unsafeCoerce# marr#))
unsafeThawIOArray :: Ix ix => Arr.Array ix e -> IO (IOArray ix e)
unsafeThawIOArray arr = stToIO $ do
marr <- ArrST.unsafeThawSTArray arr
return (IOArray marr)
thawIOArray :: Ix ix => Arr.Array ix e -> IO (IOArray ix e)
thawIOArray arr = stToIO $ do
marr <- ArrST.thawSTArray arr
return (IOArray marr)
freezeIOArray :: Ix ix => IOArray ix e -> IO (Arr.Array ix e)
freezeIOArray (IOArray marr) = stToIO (ArrST.freezeSTArray marr)
unsafeFreezeIOArray :: Ix ix => IOArray ix e -> IO (Arr.Array ix e)
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#)