Boxed.hs

{-# LANGUAGE TypeFamilyDependencies, FlexibleContexts, GADTs, TypeOperators #-}
{-|
Boxed arrays for opaque values and arrays
-}

module Futhask.Array.Boxed where
import Futhask.Array.Element
import qualified Data.Array as A
import qualified Data.Array.Base as UA
import qualified Data.Array.IO as MA
data BArray a where
    BArray :: A.Array Int a -> Int -> Int -> BArray a
data MBArray a where
    MBArray :: MA.IOArray Int a -> Int -> Int -> MBArray a

instance Element (BArray elem) where
    type Array (BArray elem) = BArray (BArray elem)
    type MArray (BArray elem) = MBArray (BArray elem)
    size = sizeB
    unsafeRead = unsafeReadB
    msize = msizeB
    unsafePeek = unsafePeekB
    unsafePoke = unsafePokeB
    scratch = scratchB
    unsafeThaw = unsafeThawB
    unsafeFreeze = unsafeFreezeB
    unsafeSlice = unsafeSliceB

instance (Show a, Element a, BArray a ~ Array a) => Show (BArray a) where
    show = show . toList

sizeB :: BArray a -> Int
sizeB (BArray _ _ sz) = sz
unsafeReadB :: BArray a -> Int -> a
unsafeReadB (BArray a i _) idx = a A.! (i+idx)
msizeB :: MBArray a -> Int
msizeB (MBArray _ _ sz) = sz
unsafePeekB :: MBArray a -> Int -> IO a 
unsafePeekB (MBArray a i _) idx = MA.readArray a (i+idx)
unsafePokeB :: MBArray a -> Int -> a -> IO () 
unsafePokeB (MBArray a i s) idx elem = MA.writeArray a (i+idx) elem
scratchB :: Int -> IO (MBArray a)
scratchB sz = fmap (\a -> MBArray a 0 sz) (MA.newArray (0, sz-1) undefined)
unsafeThawB :: BArray a -> IO (MBArray a)
unsafeThawB (BArray a i s) = fmap (\a -> MBArray a i s) (UA.unsafeThaw a)
unsafeFreezeB :: MBArray a -> IO (BArray a)
unsafeFreezeB (MBArray a i s) = fmap (\a -> BArray a i s) (UA.unsafeFreeze a)
unsafeSliceB :: BArray a -> Int -> Int -> BArray a
unsafeSliceB (BArray a i _) i0 sz = BArray a (i+i0) sz