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) index = readUnboxed arr index
unsafeWrite (UMA _ _ arr) index = writeUnboxed arr index
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) index = indexUnboxed arr index
unsafeReplace arr ies = runST (withArrayCopy arr (doReplace ies))
unsafeAccum f arr ies = runST (withArrayCopy arr (doAccum f ies))
unsafeAccumArray f init lu ies = runST (withNewArray lu init (doAccum f ies))
withNewArray lu init action = do
marr <- newArray lu init
action marr
unsafeFreezeUA marr
withArrayCopy arr action = do
marr <- thawUA arr
action marr
unsafeFreezeUA marr
doReplace ies marr = do
sequence_ [unsafeWrite marr i e | (i, e) <- ies]
doAccum f ies marr = do
sequence_ [do old <- unsafeRead marr i
unsafeWrite marr i (f old new)
| (i, new) <- ies]
freezeUA uma@(UMA l u marr) = do
arr <- freezeUnboxed marr (sizeOfUMA uma)
return (UA l u arr)
thawUA ua@(UA l u arr) = do
marr <- thawUnboxed arr (sizeOfUA ua)
return (UMA l u marr)
unsafeFreezeUA (UMA l u marr) = do
arr <- unsafeFreezeUnboxed marr
return (UA l u arr)
unsafeThawUA ua@(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