#ifdef LANGUAGE_DataKinds
#endif
#ifdef LANGUAGE_Trustworthy
#endif
module Data.Tuple.Array
( ArrayTuple
, ArraySlice
) where
import Control.Applicative
import Control.Monad.Prim
import Data.Prim.Array
import Data.Tuple.ITuple
import Data.Tuple.ITuple.Proxy
import Data.Tuple.MTuple
import Data.Typeable (Typeable)
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)
newtype ArrayTuple s a = ArrayTuple (MutableArray s Any) deriving (Eq, Typeable)
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MTuple (ArrayTuple s) t m where
thawTuple a = runPrim $ do
array <- newArray (sizeOf a) undefined
writeTuple array 0 (toTuple a)
return $ ArrayTuple array
freezeTuple (ArrayTuple array) = runPrim $ fromTuple <$> readTuple array 0
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField1 (ArrayTuple s) t m where
read1 = unsafeRead 0
write1 = unsafeWrite 0
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField2 (ArrayTuple s) t m where
read2 = unsafeRead 1
write2 = unsafeWrite 1
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField3 (ArrayTuple s) t m where
read3 = unsafeRead 2
write3 = unsafeWrite 2
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField4 (ArrayTuple s) t m where
read4 = unsafeRead 3
write4 = unsafeWrite 3
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField5 (ArrayTuple s) t m where
read5 = unsafeRead 4
write5 = unsafeWrite 4
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField6 (ArrayTuple s) t m where
read6 = unsafeRead 5
write6 = unsafeWrite 5
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField7 (ArrayTuple s) t m where
read7 = unsafeRead 6
write7 = unsafeWrite 6
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField8 (ArrayTuple s) t m where
read8 = unsafeRead 7
write8 = unsafeWrite 7
instance ( MonadPrim m
, s ~ World m
, ITuple t
, ArraySlice (Tuple (ListRep t))
) => MField9 (ArrayTuple s) t m where
read9 = unsafeRead 8
write9 = unsafeWrite 8
sizeOf :: (ITuple t, ArraySlice (Tuple (ListRep t))) => t -> Int
sizeOf = size . proxyTuple
class ArraySlice a where
size :: t a -> Int
readTuple :: MutableArray s Any -> Int -> Prim s a
writeTuple :: MutableArray s Any -> Int -> a -> Prim s ()
instance ArraySlice (Tuple Nil) where
size _ = 0
readTuple _ _ = return U
writeTuple _ _ _ = return ()
instance ArraySlice (Tuple xs) => ArraySlice (Tuple (x :| xs)) where
size xs = 1 + size (reproxyTail xs)
readTuple array i = do
x <- unsafeCoerce <$> readArray array i
xs <- readTuple array (i + 1)
return $ x :* xs
writeTuple array i (x :* xs) = do
writeArray array i (unsafeCoerce x)
writeTuple array (i + 1) xs
unsafeRead :: MonadPrim m => Int -> ArrayTuple (World m) t -> m a
unsafeRead i (ArrayTuple array) = runPrim $ unsafeCoerce <$> readArray array i
unsafeWrite :: MonadPrim m => Int -> ArrayTuple (World m) t -> a -> m ()
unsafeWrite i (ArrayTuple array) = runPrim . writeArray array i . unsafeCoerce