module Data.Microgroove.Mutable (
MRec(MRec#,MRNil,MRCons)
,new#
,index
,rmap, rmapM
,crmap, crmapM
,modify_, cmodify_, modify
,rzip, crzip
,toMVector, ctoMVector
,subRecord#
,module X
) where
import Data.Microgroove.Lib
import Data.Microgroove.Lib.Vector
import qualified Data.Vector.Mutable as VM
import Data.Vector.Mutable as X (MVector)
import Control.Monad.Primitive as X (PrimMonad(..))
import GHC.Exts as X (RealWorld)
newtype MRec s (f :: u -> *) (us :: [u]) = MRec# (MVector s Any)
data MRec' s (f :: u -> *) (us :: [u]) where
MRNil' :: MRec' s f '[]
MRCons' :: MVector s (f u) -> MRec s f us -> MRec' s f (u ': us)
upMRec :: MRec s f us -> MRec' s f us
upMRec (MRec# v) | VM.null v = cast# MRNil'
| otherwise = cast# $ MRCons' (cast# $ VM.take 1 v) (MRec# $ VM.tail v)
pattern MRNil :: () => (us ~ '[]) => MRec s f us
pattern MRNil <- (upMRec -> MRNil')
pattern MRCons :: () => (us' ~ (u ': us)) => VM.MVector s (f u) -> MRec s f us -> MRec s f us'
pattern MRCons x xs <- (upMRec -> MRCons' x xs)
rmap :: forall g m f xs. PrimMonad m => (forall x. f x -> g x) -> MRec (PrimState m) f xs -> m (MRec (PrimState m) g xs)
rmap f xs = cast# xs <$ go xs where
go :: MRec (PrimState m) f as -> m ()
go = \case
MRNil -> pure ()
MRCons x xs' -> VM.modify x (castf# @f . f) 0 >> go xs'
rmapM :: forall g m f xs. PrimMonad m => (forall x. f x -> m (g x)) -> MRec (PrimState m) f xs -> m (MRec (PrimState m) g xs)
rmapM f xs = cast# xs <$ go xs where
go :: MRec (PrimState m) f as -> m ()
go = \case
MRNil -> pure ()
MRCons x xs' -> do
x' <- f =<< VM.unsafeRead x 0
VM.write x 0 (castf# @f x')
go xs'
crmapM :: forall (c :: * -> Constraint) g m f xs. (AllF c f xs, PrimMonad m)
=> (forall x. c (f x) => f x -> m (g x)) -> MRec (PrimState m) f xs
-> m (MRec (PrimState m) g xs)
crmapM f xs = cast# xs <$ go xs where
go :: AllF c f as => MRec (PrimState m) f as -> m ()
go = \case
MRNil -> pure ()
MRCons x xs' -> do
x' <- f =<< VM.unsafeRead x 0
VM.write x 0 (castf# @f x')
go xs'
rzip :: forall h m (f :: k -> *) g (xs :: [k]). PrimMonad m
=> (forall x. f x -> g x -> h x)
-> MRec (PrimState m) f xs -> MRec (PrimState m) g xs
-> m (MRec (PrimState m) h xs)
rzip f xs ys = cast# ys <$ go xs ys where
go :: MRec (PrimState m) f as -> MRec (PrimState m) g as -> m ()
go MRNil MRNil = pure ()
go (MRCons x xs') (MRCons y ys') = do
x' <- VM.unsafeRead x 0
VM.modify y (castf# @g . f x') 0
go xs' ys'
index :: forall n m f xs. (KnownNat n,PrimMonad m) => MRec (PrimState m) f xs -> m (f (xs !! n))
index (MRec# vm) = mapCast# $ vm `VM.unsafeRead` intVal @n
crmap :: forall (c :: * -> Constraint) g m f xs. (AllF c f xs, PrimMonad m)
=> (forall x. c (f x) => f x -> g x) -> MRec (PrimState m) f xs -> m (MRec (PrimState m) g xs)
crmap f xs = cast# xs <$ go xs where
go :: AllF c f as => MRec (PrimState m) f as -> m ()
go = \case
MRNil -> pure ()
MRCons x xs' -> VM.modify x (castf# @f . f) 0 >> go xs'
crzip :: forall (c :: * -> Constraint) h m (f :: k -> *) g (xs :: [k])
. (AllF c f xs, AllF c g xs, PrimMonad m)
=> (forall x. (c (f x), c (g x)) => f x -> g x -> h x)
-> MRec (PrimState m) f xs -> MRec (PrimState m) g xs
-> m (MRec (PrimState m) h xs)
crzip f xs ys = cast# ys <$ go xs ys where
go :: (AllF c f as, AllF c g as)
=> MRec (PrimState m) f as -> MRec (PrimState m) g as -> m ()
go MRNil MRNil = pure ()
go (MRCons x xs') (MRCons y ys') = do
x' <- VM.unsafeRead x 0
VM.modify y (castf# @g . f x') 0
go xs' ys'
toMVector :: forall r m f xs. PrimMonad m
=> (forall x. f x -> r) -> MRec (PrimState m) f xs -> m (MVector (PrimState m) r)
toMVector f xs = cast# xs <$ go xs where
go :: MRec (PrimState m) f as -> m ()
go = \case
MRNil -> pure ()
MRCons x xs' -> VM.modify x (cast# . f) 0 >> go xs'
ctoMVector :: forall (c :: * -> Constraint) r m f xs. (AllF c f xs, PrimMonad m)
=> (forall x. c (f x) => f x -> r) -> MRec (PrimState m) f xs -> m (MVector (PrimState m) r)
ctoMVector f xs = cast# xs <$ go xs where
go :: AllF c f as => MRec (PrimState m) f as -> m ()
go = \case
MRNil -> pure ()
MRCons x xs' -> VM.modify x (cast# . f) 0 >> go xs'
new# :: forall f xs m. (KnownNat (Length xs), PrimMonad m) => m (MRec (PrimState m) f xs)
new# = MRec# <$> VM.unsafeNew (intVal @(Length xs))
modify_ :: forall n m f xs. (KnownNat n, PrimMonad m)
=> (forall x. f x -> f x) -> MRec (PrimState m) f xs
-> m ()
modify_ f (MRec# vm) = VM.modify vm (cast# @Any . f . cast#) (intVal @n)
cmodify_ :: forall (c :: * -> Constraint) n m f xs. (c (f (xs!!n)), KnownNat n, PrimMonad m)
=> (forall x. c (f x) => f x -> f x) -> MRec (PrimState m) f xs
-> m ()
cmodify_ f (MRec# vm) = VM.modify vm (cast# @Any . f . cast# @(f (xs !! n))) (intVal @n)
modify :: forall n m f xs y. (KnownNat n, PrimMonad m)
=> (f (xs !! n) -> f y) -> MRec (PrimState m) f xs
-> m (MRec (PrimState m) f (SetAt n xs y))
modify f rm@(MRec# vm) = cast# rm <$ VM.modify vm (cast# @Any . f . cast#) (intVal @n)
subRecord# :: forall ns m f xs. (KnownNat (Length ns), KnownNats ns,PrimMonad m)
=> MRec (PrimState m) f xs -> m (MRec (PrimState m) f (SubList# ns xs))
subRecord# (MRec# vm) = MRec# <$> subVector# (intVal @(Length ns)) (intList @ns) vm