module Data.ArrayBZ.Internals.Unboxed where
import Control.Monad.ST (ST, runST)
import Control.Monad.ST.Lazy ( strictToLazyST )
import qualified Control.Monad.ST.Lazy as Lazy (ST)
import Data.Ix
import Data.Typeable
#include "Typeable.h"
import Control.Monad.STorIO
import Data.ArrayBZ.Internals.IArray
import Data.ArrayBZ.Internals.MArray
import Data.HasDefaultValue
import Data.Unboxed
data UnboxedMutableArray s i e = UMA !i !i !(MUVec s e)
instance HasBounds (UnboxedMutableArray s) where
bounds (UMA l u _) = (l,u)
instance (STorIO m s) => HasMutableBounds (UnboxedMutableArray s) m where
getBounds (UMA l u _) = return (l,u)
instance (STorIO m s, Unboxed e) => MArray (UnboxedMutableArray s) e m where
newArray_ (l,u) = do arr <- allocUnboxed (rangeSize (l,u))
return (UMA l u arr)
unsafeRead (UMA _ _ arr) = readUnboxed arr
unsafeWrite (UMA _ _ arr) = writeUnboxed arr
type STUArray = UnboxedMutableArray
INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
instance (Unboxed e) => MArray (STUArray s) e (Lazy.ST s) where
newArray_ (l,u) = strictToLazyST (newArray_ (l,u))
unsafeRead arr i = strictToLazyST (unsafeRead arr i)
unsafeWrite arr i e = strictToLazyST (unsafeWrite arr i e)
type IOUArray = IOSpecific3 UnboxedMutableArray
INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")
data UArray i e = UA !i !i !(UVec e)
INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
instance HasBounds UArray where
bounds (UA l u _) = (l,u)
instance (Unboxed e, HasDefaultValue e) => IArray UArray e where
unsafeArray lu ies = runST (withNewArray lu defaultValue (doReplace ies))
unsafeAt (UA _ _ arr) = indexUnboxed arr
unsafeReplace arr ies = runST (withArrayCopy arr (doReplace ies))
unsafeAccum f arr ies = runST (withArrayCopy arr $ doAccum f ies)
unsafeAccumArray f int lu ies = runST (withNewArray lu int $ doAccum f ies)
withNewArray :: (STorIO t t2,
Ix i,
MArray (UnboxedMutableArray t2) e t) =>
(i, i)
-> e
-> (UnboxedMutableArray t2 i e -> t t1)
-> t (UArray i e)
withNewArray lu int action = do
marr <- newArray lu int
action marr
unsafeFreezeUA marr
withArrayCopy :: (Ix t, Unboxed t1, STorIO t2 s) =>
UArray t t1
-> (UnboxedMutableArray s t t1 -> t2 t3)
-> t2 (UArray t t1)
withArrayCopy arr action = do
marr <- thawUA arr
action marr
unsafeFreezeUA marr
doReplace :: (Ix i, MArray a e t) => [(Int, e)] -> a i e -> t ()
doReplace ies marr = do
sequence_ [unsafeWrite marr i e | (i, e) <- ies]
doAccum :: (Ix i, MArray a t1 t2) => (t1 -> t -> t1) -> [(Int, t)] -> a i t1 -> t2 ()
doAccum f ies marr = do
sequence_ [do old <- unsafeRead marr i
unsafeWrite marr i (f old new)
| (i, new) <- ies]
freezeUA :: (STorIO t3 t, Unboxed t2, Ix t1) => UnboxedMutableArray t t1 t2 -> t3 (UArray t1 t2)
freezeUA uma@(UMA l u marr) = do
arr <- freezeUnboxed marr (sizeOfUMA uma)
return (UA l u arr)
thawUA :: (STorIO t2 s, Unboxed t1, Ix t) => UArray t t1 -> t2 (UnboxedMutableArray s t t1)
thawUA ua@(UA l u arr) = do
marr <- thawUnboxed arr (sizeOfUA ua)
return (UMA l u marr)
unsafeFreezeUA :: (STorIO t3 t1) => UnboxedMutableArray t1 t t2 -> t3 (UArray t t2)
unsafeFreezeUA (UMA l u marr) = do
arr <- unsafeFreezeUnboxed marr
return (UA l u arr)
unsafeThawUA :: (STorIO t2 s) => UArray t t1 -> t2 (UnboxedMutableArray s t t1)
unsafeThawUA (UA l u arr) = do
marr <- unsafeThawUnboxed arr
return (UMA l u marr)
sizeOfUA :: forall i e. (Ix i, Unboxed e) => UArray i e -> Int
sizeOfUA arr =
rangeSize (bounds arr) * sizeOfUnboxed (undefined :: e)
sizeOfUMA :: forall i e s. (Ix i, Unboxed e) => UnboxedMutableArray s i e -> Int
sizeOfUMA marr =
rangeSize (bounds marr) * sizeOfUnboxed (undefined :: e)
freezeIOUArray :: (Unboxed e, HasDefaultValue e, Ix i) => IOUArray i e -> IO (UArray i e)
thawIOUArray :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> IO (IOUArray i e)
unsafeFreezeIOUArray :: (Unboxed e, HasDefaultValue e, Ix i) => IOUArray i e -> IO (UArray i e)
unsafeThawIOUArray :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> IO (IOUArray i e)
freezeIOUArray = freezeUA
thawIOUArray = thawUA
unsafeFreezeIOUArray = unsafeFreezeUA
unsafeThawIOUArray = unsafeThawUA
freezeSTUArray :: (Unboxed e, HasDefaultValue e, Ix i) => STUArray s i e -> ST s (UArray i e)
thawSTUArray :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> ST s (STUArray s i e)
unsafeFreezeSTUArray :: (Unboxed e, HasDefaultValue e, Ix i) => STUArray s i e -> ST s (UArray i e)
unsafeThawSTUArray :: (Unboxed e, HasDefaultValue e, Ix i) => UArray i e -> ST s (STUArray s i e)
freezeSTUArray = freezeUA
thawSTUArray = thawUA
unsafeFreezeSTUArray = unsafeFreezeUA
unsafeThawSTUArray = unsafeThawUA
castUArray :: forall i e e'. (Ix i, Enum i, Unboxed e, Unboxed e')
=> UArray i e -> UArray i e'
castUArray (UA l u vec) =
(UA l u' (castUnboxed vec))
where u' = toEnum (fromEnum l 1 + newSize)
newSize = rangeSize (l,u) * sizeOfUnboxed (undefined::e)
`div` sizeOfUnboxed (undefined::e')
castIOUArray :: forall i e e'. (Ix i, Enum i, Unboxed e, Unboxed e')
=> IOUArray i e -> IOUArray i e'
castIOUArray (UMA l u mvec) =
(UMA l u' (castMUnboxed mvec))
where u' = toEnum (fromEnum l 1 + newSize)
newSize = rangeSize (l,u) * sizeOfUnboxed (undefined::e)
`div` sizeOfUnboxed (undefined::e')
castSTUArray :: forall i e e' s. (Ix i, Enum i, Unboxed e, Unboxed e')
=> STUArray s i e -> STUArray s i e'
castSTUArray (UMA l u mvec) =
(UMA l u' (castMUnboxed mvec))
where u' = toEnum (fromEnum l 1 + newSize)
newSize = rangeSize (l,u) * sizeOfUnboxed (undefined::e)
`div` sizeOfUnboxed (undefined::e')
instance (Ix i, Show i, Show e, Unboxed e, HasDefaultValue e) => Show (UArray i e) where
showsPrec = showsIArray
instance (Ix i, Eq i, Eq e, Unboxed e, HasDefaultValue e) => Eq (UArray i e) where
(==) = eqIArray
instance (Ix i, Ord i, Ord e, Unboxed e, HasDefaultValue e) => Ord (UArray i e) where
compare = cmpIArray