{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns, BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MagicHash, UnboxedTuples #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Extensible.Struct (
Struct
, set
, get
, new
, newRepeat
, newFor
, newFromHList
, WrappedPointer(..)
, (-$>)
, atomicModify
, atomicModify'
, atomicModify_
, atomicModify'_
, (:&)
, (:*)
, unsafeFreeze
, newFrom
, hlookup
, hlength
, type (++)
, happend
, hfoldrWithIndex
, thaw
, hfrozen
, hmodify
, toHList) where
import GHC.Prim
import Control.Comonad
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Constraint
import Data.Extensible.Class
import Data.Extensible.Internal.Rig
import Data.Extensible.Wrapper
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.Proxy
import Data.Kind (Type)
import qualified Data.StateVar as V
import GHC.Types
import qualified Type.Membership.HList as L
data Struct s (h :: k -> Type) (xs :: [k]) = Struct (SmallMutableArray# s Any)
set :: PrimMonad m => Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set :: Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) e :: h x
e = (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
((State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ())
-> (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case (SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any)
-> SmallMutableArray# (PrimState m) Any
-> Int#
-> h x
-> State# (PrimState m)
-> State# (PrimState m)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any
forall d k1.
SmallMutableArray# d k1 -> Int# -> k1 -> State# d -> State# d
writeSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i h x
e State# (PrimState m)
s of
s' :: State# (PrimState m)
s' -> (# State# (PrimState m)
s', () #)
{-# INLINE set #-}
get :: PrimMonad m => Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get :: Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) = (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x))
-> (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall a b. (a -> b) -> a -> b
$ (SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #))
-> SmallMutableArray# (PrimState m) Any
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), h x #)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #)
forall d k1.
SmallMutableArray# d k1 -> Int# -> State# d -> (# State# d, k1 #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i
{-# INLINE get #-}
atomicModify :: PrimMonad m
=> Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) f :: h x -> (h x, a)
f = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \s0 :: State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) Any
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), Any #)
forall d k1.
SmallMutableArray# d k1 -> Int# -> State# d -> (# State# d, k1 #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i State# (PrimState m)
s0 of
(# s :: State# (PrimState m)
s, x :: Any
x #) -> Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry Any
x State# (PrimState m)
s
where
retry :: Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry x :: Any
x s :: State# (PrimState m)
s = let p :: (Any, a)
p = (h x -> (h x, a)) -> Any -> (Any, a)
unsafeCoerce# h x -> (h x, a)
f Any
x in
case SmallMutableArray# (PrimState m) Any
-> Int#
-> Any
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), Int#, Any #)
forall d k1.
SmallMutableArray# d k1
-> Int# -> k1 -> k1 -> State# d -> (# State# d, Int#, k1 #)
casSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i Any
x ((Any, a) -> Any
forall a b. (a, b) -> a
fst (Any, a)
p) State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', b :: Int#
b, y :: Any
y #) -> case Int#
b of
0# -> (# State# (PrimState m)
s', (Any, a) -> a
forall a b. (a, b) -> b
snd (Any, a)
p #)
_ -> Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry Any
y State# (PrimState m)
s'
{-# INLINE atomicModify #-}
atomicModify' :: PrimMonad m
=> Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify' :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify' s :: Struct (PrimState m) h xs
s i :: Membership xs x
i f :: h x -> (h x, a)
f = Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k) a.
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify Struct (PrimState m) h xs
s Membership xs x
i
(\x :: h x
x -> let (y :: h x
y, a :: a
a) = h x -> (h x, a)
f h x
x in (h x
y, h x
y h x -> a -> a
forall k1 a. k1 -> a -> a
`seq` a
a))
m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$!)
{-# INLINE atomicModify' #-}
atomicModify_ :: PrimMonad m
=> Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ (Struct m :: SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) f :: h x -> h x
f = (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
((State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x))
-> (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall a b. (a -> b) -> a -> b
$ \s0 :: State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) Any
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), Any #)
forall d k1.
SmallMutableArray# d k1 -> Int# -> State# d -> (# State# d, k1 #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i State# (PrimState m)
s0 of
(# s :: State# (PrimState m)
s, x :: Any
x #) -> Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry Any
x State# (PrimState m)
s
where
retry :: Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry x :: Any
x s :: State# (PrimState m)
s = case SmallMutableArray# (PrimState m) Any
-> Int#
-> Any
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), Int#, Any #)
forall d k1.
SmallMutableArray# d k1
-> Int# -> k1 -> k1 -> State# d -> (# State# d, Int#, k1 #)
casSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i Any
x ((h x -> h x) -> Any -> Any
unsafeCoerce# h x -> h x
f Any
x) State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', b :: Int#
b, y :: Any
y #) -> case Int#
b of
0# -> (# State# (PrimState m)
s', Any -> h x
unsafeCoerce# Any
y #)
_ -> Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry Any
y State# (PrimState m)
s'
{-# INLINE atomicModify_ #-}
atomicModify'_ :: PrimMonad m
=> Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ :: Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ s :: Struct (PrimState m) h xs
s i :: Membership xs x
i f :: h x -> h x
f = Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ Struct (PrimState m) h xs
s Membership xs x
i h x -> h x
f m (h x) -> (h x -> m (h x)) -> m (h x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (h x -> m (h x)
forall (m :: * -> *) a. Monad m => a -> m a
return (h x -> m (h x)) -> h x -> m (h x)
forall a b. (a -> b) -> a -> b
$!)
{-# INLINE atomicModify'_ #-}
data WrappedPointer s h a where
WrappedPointer :: !(Struct s h xs)
-> !(Membership xs x)
-> WrappedPointer s h (Repr h x)
instance (s ~ RealWorld, Wrapper h) => V.HasGetter (WrappedPointer s h a) a where
get :: WrappedPointer s h a -> m a
get (WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Optic' (->) (Const a) (h x) a -> h x -> a
forall a s. Optic' (->) (Const a) s a -> s -> a
view Optic' (->) (Const a) (h x) a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper (h x -> a) -> IO (h x) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Struct (PrimState IO) h xs -> Membership xs x -> IO (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i
instance (s ~ RealWorld, Wrapper h) => V.HasSetter (WrappedPointer s h a) a where
WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i $= :: WrappedPointer s h a -> a -> m ()
$= v :: a
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Struct (PrimState IO) h xs -> Membership xs x -> h x -> IO ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i (h x -> IO ()) -> h x -> IO ()
forall a b. (a -> b) -> a -> b
$ Optic' Tagged Identity (h x) a -> a -> h x
forall s a. Optic' Tagged Identity s a -> a -> s
review Optic' Tagged Identity (h x) a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a
v
instance (s ~ RealWorld, Wrapper h) => V.HasUpdate (WrappedPointer s h a) a a where
WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i $~ :: WrappedPointer s h a -> (a -> a) -> m ()
$~ f :: a -> a
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO (h x) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (h x) -> IO ()) -> IO (h x) -> IO ()
forall a b. (a -> b) -> a -> b
$ Struct (PrimState IO) h xs
-> Membership xs x -> (h x -> h x) -> IO (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i ((h x -> h x) -> IO (h x)) -> (h x -> h x) -> IO (h x)
forall a b. (a -> b) -> a -> b
$ Optic (->) Identity (h x) (h x) a a -> (a -> a) -> h x -> h x
forall s t a b. Optic (->) Identity s t a b -> (a -> b) -> s -> t
over Optic (->) Identity (h x) (h x) a a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a -> a
f
WrappedPointer s :: Struct s h xs
s i :: Membership xs x
i $~! :: WrappedPointer s h a -> (a -> a) -> m ()
$~! f :: a -> a
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO (h x) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (h x) -> IO ()) -> IO (h x) -> IO ()
forall a b. (a -> b) -> a -> b
$ Struct (PrimState IO) h xs
-> Membership xs x -> (h x -> h x) -> IO (h x)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ Struct s h xs
Struct (PrimState IO) h xs
s Membership xs x
i ((h x -> h x) -> IO (h x)) -> (h x -> h x) -> IO (h x)
forall a b. (a -> b) -> a -> b
$ Optic (->) Identity (h x) (h x) a a -> (a -> a) -> h x -> h x
forall s t a b. Optic (->) Identity s t a b -> (a -> b) -> s -> t
over Optic (->) Identity (h x) (h x) a a
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a -> a
f
(-$>) :: forall k h xs v s. (Lookup xs k v) => Struct s h xs -> Proxy k -> WrappedPointer s h (Repr h (k ':> v))
s :: Struct s h xs
s -$> :: Struct s h xs -> Proxy k -> WrappedPointer s h (Repr h (k ':> v))
-$> _ = Struct s h xs
-> Membership xs (k ':> v) -> WrappedPointer s h (Repr h (k ':> v))
forall k s (h :: k -> *) (xs :: [k]) (x :: k).
Struct s h xs -> Membership xs x -> WrappedPointer s h (Repr h x)
WrappedPointer Struct s h xs
s (Membership xs (k ':> v)
forall k k1 (xs :: [Assoc k k1]) (k2 :: k) (v :: k1).
Lookup xs k2 v =>
Membership xs (k2 ':> v)
association :: Membership xs (k ':> v))
{-# INLINE (-$>) #-}
new :: forall h m xs. (PrimMonad m, Generate xs)
=> (forall x. Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
new :: (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
new = Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
forall k (m :: * -> *) (xs :: [k]) (h :: k -> *).
PrimMonad m =>
Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newDict Dict (Generate xs)
forall (a :: Constraint). a => Dict a
Dict
{-# INLINE new #-}
newDict :: PrimMonad m
=> Dict (Generate xs)
-> (forall x. Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newDict :: Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newDict Dict k :: forall (x :: k). Membership xs x -> h x
k = do
Struct (PrimState m) h xs
m <- (forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
forall k (h :: k -> *) (m :: * -> *) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat forall (x :: k). h x
forall a. HasCallStack => a
undefined
(forall (x :: k).
Membership xs x
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall k (xs :: [k]) r.
Generate xs =>
(forall (x :: k). Membership xs x -> r -> r) -> r -> r
henumerate (\i :: Membership xs x
i cont :: m (Struct (PrimState m) h xs)
cont -> Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
m Membership xs x
i (Membership xs x -> h x
forall (x :: k). Membership xs x -> h x
k Membership xs x
i) m ()
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Struct (PrimState m) h xs)
cont) (m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE[0] newDict #-}
newRepeat :: forall h m xs. (PrimMonad m, Generate xs)
=> (forall x. h x)
-> m (Struct (PrimState m) h xs)
newRepeat :: (forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat x :: forall (x :: k). h x
x = do
let !(I# n :: Int#
n) = Proxy xs -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
Generate xs =>
proxy xs -> Int
hcount (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
(State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# Int#
n (h Any -> Any
unsafeCoerce# h Any
forall (x :: k). h x
x) State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', a :: SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)
{-# INLINE newRepeat #-}
newFor :: forall proxy c h m xs. (PrimMonad m, Forall c xs)
=> proxy c
-> (forall x. c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newFor :: proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newFor = Dict (Forall c xs)
-> proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
forall k (proxy :: (k -> Constraint) -> *) (c :: k -> Constraint)
(h :: k -> *) (m :: * -> *) (xs :: [k]).
PrimMonad m =>
Dict (Forall c xs)
-> proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newForDict Dict (Forall c xs)
forall (a :: Constraint). a => Dict a
Dict
{-# INLINE newFor #-}
newForDict :: forall proxy c h m xs. (PrimMonad m)
=> Dict (Forall c xs)
-> proxy c
-> (forall x. c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newForDict :: Dict (Forall c xs)
-> proxy c
-> (forall (x :: k). c x => Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newForDict Dict p :: proxy c
p k :: forall (x :: k). c x => Membership xs x -> h x
k = do
Struct (PrimState m) h xs
m <- (forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
forall k (h :: k -> *) (m :: * -> *) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat forall (x :: k). h x
forall a. HasCallStack => a
undefined
proxy c
-> Proxy xs
-> (forall (x :: k).
c x =>
Membership xs x
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs)
-> m (Struct (PrimState m) h xs)
forall k (c :: k -> Constraint) (xs :: [k])
(proxy :: (k -> Constraint) -> *) (proxy' :: [k] -> *) r.
Forall c xs =>
proxy c
-> proxy' xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
henumerateFor proxy c
p (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs) (\i :: Membership xs x
i cont :: m (Struct (PrimState m) h xs)
cont -> Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
m Membership xs x
i (Membership xs x -> h x
forall (x :: k). c x => Membership xs x -> h x
k Membership xs x
i) m ()
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Struct (PrimState m) h xs)
cont) (m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs))
-> m (Struct (PrimState m) h xs) -> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE[0] newForDict #-}
newFromHList :: forall h m xs. PrimMonad m => L.HList h xs -> m (Struct (PrimState m) h xs)
newFromHList :: HList h xs -> m (Struct (PrimState m) h xs)
newFromHList l :: HList h xs
l = do
let !(I# size :: Int#
size) = HList h xs -> Int
forall k (h :: k -> *) (xs :: [k]). HList h xs -> Int
L.hlength HList h xs
l
Struct (PrimState m) h xs
m <- (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# Int#
size Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', a :: SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)
let go :: Int -> L.HList h t -> m ()
go :: Int -> HList h t -> m ()
go _ L.HNil = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go i :: Int
i (L.HCons x :: h x
x xs :: HList h xs1
xs) = Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
m (Int -> Membership xs x
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i) h x
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> HList h xs1 -> m ()
forall (t :: [k]). Int -> HList h t -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) HList h xs1
xs
Int -> HList h xs -> m ()
forall (t :: [k]). Int -> HList h t -> m ()
go 0 HList h xs
l
Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE newFromHList #-}
data (s :: [k]) :& (h :: k -> *) = HProduct (SmallArray# Any)
type h :* xs = xs :& h
{-# DEPRECATED (:*) "Use :& instead" #-}
unsafeFreeze :: PrimMonad m => Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze :: Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze (Struct m :: SmallMutableArray# (PrimState m) Any
m) = (State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
-> m (xs :& h)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
-> m (xs :& h))
-> (State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
-> m (xs :& h)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# Any #)
forall d k1.
SmallMutableArray# d k1
-> State# d -> (# State# d, SmallArray# k1 #)
unsafeFreezeSmallArray# SmallMutableArray# (PrimState m) Any
m State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', a :: SmallArray# Any
a #) -> (# State# (PrimState m)
s', SmallArray# Any -> xs :& h
forall k (s :: [k]) (h :: k -> *). SmallArray# Any -> s :& h
HProduct SmallArray# Any
a #)
{-# INLINE unsafeFreeze #-}
thaw :: PrimMonad m => xs :& h -> m (Struct (PrimState m) h xs)
thaw :: (xs :& h) -> m (Struct (PrimState m) h xs)
thaw (HProduct ar :: SmallArray# Any
ar) = (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case SmallArray# Any
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
SmallArray# k1
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d k1 #)
thawSmallArray# SmallArray# Any
ar 0# (SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
ar) State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', m :: SmallMutableArray# (PrimState m) Any
m #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
m #)
hlength :: xs :& h -> Int
hlength :: (xs :& h) -> Int
hlength (HProduct ar :: SmallArray# Any
ar) = Int# -> Int
I# (SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
ar)
{-# INLINE hlength #-}
type family (++) (xs :: [k]) (ys :: [k]) :: [k] where
'[] ++ ys = ys
(x ': xs) ++ ys = x ': xs ++ ys
infixr 5 ++
happend :: xs :& h -> ys :& h -> (xs ++ ys) :& h
happend :: (xs :& h) -> (ys :& h) -> (xs ++ ys) :& h
happend (HProduct lhs :: SmallArray# Any
lhs) (HProduct rhs :: SmallArray# Any
rhs) = (forall s. ST s ((xs ++ ys) :& h)) -> (xs ++ ys) :& h
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ((xs ++ ys) :& h)) -> (xs ++ ys) :& h)
-> (forall s. ST s ((xs ++ ys) :& h)) -> (xs ++ ys) :& h
forall a b. (a -> b) -> a -> b
$ (State# (PrimState (ST s))
-> (# State# (PrimState (ST s)), (xs ++ ys) :& h #))
-> ST s ((xs ++ ys) :& h)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState (ST s))
-> (# State# (PrimState (ST s)), (xs ++ ys) :& h #))
-> ST s ((xs ++ ys) :& h))
-> (State# (PrimState (ST s))
-> (# State# (PrimState (ST s)), (xs ++ ys) :& h #))
-> ST s ((xs ++ ys) :& h)
forall a b. (a -> b) -> a -> b
$ \s0 :: State# (PrimState (ST s))
s0 ->
let lhsSz :: Int#
lhsSz = SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
lhs
rhsSz :: Int#
rhsSz = SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
rhs
in case Int# -> Any -> State# s -> (# State# s, SmallMutableArray# s Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# (Int#
lhsSz Int# -> Int# -> Int#
+# Int#
rhsSz) Any
forall a. HasCallStack => a
undefined State# s
State# (PrimState (ST s))
s0 of { (# s1 :: State# s
s1, a :: SmallMutableArray# s Any
a #) ->
case SmallArray# Any
-> Int#
-> SmallMutableArray# s Any
-> Int#
-> Int#
-> State# s
-> State# s
forall k1 d.
SmallArray# k1
-> Int#
-> SmallMutableArray# d k1
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# Any
lhs 0# SmallMutableArray# s Any
a 0# Int#
lhsSz State# s
s1 of { s2 :: State# s
s2 ->
case SmallArray# Any
-> Int#
-> SmallMutableArray# s Any
-> Int#
-> Int#
-> State# s
-> State# s
forall k1 d.
SmallArray# k1
-> Int#
-> SmallMutableArray# d k1
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# Any
rhs 0# SmallMutableArray# s Any
a Int#
lhsSz Int#
rhsSz State# s
s2 of { s3 :: State# s
s3 ->
case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallArray# Any #)
forall d k1.
SmallMutableArray# d k1
-> State# d -> (# State# d, SmallArray# k1 #)
unsafeFreezeSmallArray# SmallMutableArray# s Any
a State# s
s3 of { (# s4 :: State# s
s4, frz :: SmallArray# Any
frz #) ->
(# State# s
State# (PrimState (ST s))
s4, SmallArray# Any -> (xs ++ ys) :& h
forall k (s :: [k]) (h :: k -> *). SmallArray# Any -> s :& h
HProduct SmallArray# Any
frz #) }}}}
infixr 5 `happend`
unsafeMembership :: Int -> Membership xs x
unsafeMembership :: Int -> Membership xs x
unsafeMembership = Int -> Membership xs x
unsafeCoerce#
hfoldrWithIndex :: (forall x. Membership xs x -> h x -> r -> r) -> r -> xs :& h -> r
hfoldrWithIndex :: (forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex f :: forall (x :: k). Membership xs x -> h x -> r -> r
f r :: r
r p :: xs :& h
p = (Int -> r -> r) -> r -> [Int] -> r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\i :: Int
i -> let m :: Membership xs Any
m = Int -> Membership xs Any
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i in Membership xs Any -> h Any -> r -> r
forall (x :: k). Membership xs x -> h x -> r -> r
f Membership xs Any
m (Membership xs Any -> (xs :& h) -> h Any
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs Any
m xs :& h
p)) r
r [0..(xs :& h) -> Int
forall k (xs :: [k]) (h :: k -> *). (xs :& h) -> Int
hlength xs :& h
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
{-# INLINE hfoldrWithIndex #-}
toHList :: forall h xs. xs :& h -> L.HList h xs
toHList :: (xs :& h) -> HList h xs
toHList p :: xs :& h
p = Int -> HList h xs
go 0 where
go :: Int -> L.HList h xs
go :: Int -> HList h xs
go i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (xs :& h) -> Int
forall k (xs :: [k]) (h :: k -> *). (xs :& h) -> Int
hlength xs :& h
p = HList h '[] -> HList h xs
forall (ys :: [k]) (zs :: [k]). HList h ys -> HList h zs
unknownHList HList h '[]
forall k (h :: k -> *). HList h '[]
L.HNil
| Bool
otherwise = HList h (Any : xs) -> HList h xs
forall (ys :: [k]) (zs :: [k]). HList h ys -> HList h zs
unknownHList (HList h (Any : xs) -> HList h xs)
-> HList h (Any : xs) -> HList h xs
forall a b. (a -> b) -> a -> b
$ h Any -> HList h xs -> HList h (Any : xs)
forall k (h :: k -> *) (x :: k) (xs1 :: [k]).
h x -> HList h xs1 -> HList h (x : xs1)
L.HCons (Membership xs Any -> (xs :& h) -> h Any
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup (Int -> Membership xs Any
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i) xs :& h
p) (Int -> HList h xs
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
unknownHList :: L.HList h ys -> L.HList h zs
unknownHList :: HList h ys -> HList h zs
unknownHList = HList h ys -> HList h zs
unsafeCoerce#
{-# NOINLINE toHList #-}
{-# RULES "toHList/fromHList" forall x. toHList (hfrozen (newFromHList x)) = x #-}
newFrom :: forall g h m xs. (PrimMonad m)
=> xs :& g
-> (forall x. Membership xs x -> g x -> h x)
-> m (Struct (PrimState m) h xs)
newFrom :: (xs :& g)
-> (forall (x :: k). Membership xs x -> g x -> h x)
-> m (Struct (PrimState m) h xs)
newFrom hp :: xs :& g
hp@(HProduct ar :: SmallArray# Any
ar) k :: forall (x :: k). Membership xs x -> g x -> h x
k = do
let !n :: Int#
n = SmallArray# Any -> Int#
forall k1. SmallArray# k1 -> Int#
sizeofSmallArray# SmallArray# Any
ar
Struct (PrimState m) h xs
st <- (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs))
-> (State# (PrimState m)
-> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a b. (a -> b) -> a -> b
$ \s :: State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, SmallMutableArray# d k1 #)
newSmallArray# Int#
n Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of
(# s' :: State# (PrimState m)
s', a :: SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> *) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)
let go :: Int -> m (Struct (PrimState m) h xs)
go i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int# -> Int
I# Int#
n = Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall (m :: * -> *) a. Monad m => a -> m a
return Struct (PrimState m) h xs
st
| Bool
otherwise = do
let !m :: Membership xs Any
m = Int -> Membership xs Any
forall k (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership Int
i
Struct (PrimState m) h xs -> Membership xs Any -> h Any -> m ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct (PrimState m) h xs
st Membership xs Any
m (h Any -> m ()) -> h Any -> m ()
forall a b. (a -> b) -> a -> b
$! Membership xs Any -> g Any -> h Any
forall (x :: k). Membership xs x -> g x -> h x
k Membership xs Any
m (Membership xs Any -> (xs :& g) -> g Any
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs Any
m xs :& g
hp)
Int -> m (Struct (PrimState m) h xs)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
Int -> m (Struct (PrimState m) h xs)
go 0
{-# NOINLINE newFrom #-}
{-# RULES "newFrom/newFrom" forall p (f :: forall x. Membership xs x -> f x -> g x)
(g :: forall x. Membership xs x -> g x -> h x)
. newFrom (hfrozen (newFrom p f)) g = newFrom p (\i x -> g i (f i x)) #-}
{-# RULES "newFrom/newDict" forall d (f :: forall x. Membership xs x -> g x)
(g :: forall x. Membership xs x -> g x -> h x)
. newFrom (hfrozen (newDict d f)) g = newDict d (\i -> g i (f i)) #-}
{-# RULES "newFrom/newForDict" forall d p (f :: forall x. Membership xs x -> g x)
(g :: forall x. Membership xs x -> g x -> h x)
. newFrom (hfrozen (newForDict d p f)) g = newForDict d p (\i -> g i (f i)) #-}
hlookup :: Membership xs x -> xs :& h -> h x
hlookup :: Membership xs x -> (xs :& h) -> h x
hlookup (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# i :: Int#
i) (HProduct ar :: SmallArray# Any
ar) = case SmallArray# Any -> Int# -> (# Any #)
forall k1. SmallArray# k1 -> Int# -> (# k1 #)
indexSmallArray# SmallArray# Any
ar Int#
i of
(# a :: Any
a #) -> Any -> h x
unsafeCoerce# Any
a
{-# INLINE hlookup #-}
hfrozen :: (forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen :: (forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen m :: forall s. ST s (Struct s h xs)
m = (forall s. ST s (xs :& h)) -> xs :& h
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (xs :& h)) -> xs :& h)
-> (forall s. ST s (xs :& h)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ ST s (Struct s h xs)
forall s. ST s (Struct s h xs)
m ST s (Struct s h xs)
-> (Struct s h xs -> ST s (xs :& h)) -> ST s (xs :& h)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct s h xs -> ST s (xs :& h)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]).
PrimMonad m =>
Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze
{-# INLINE[0] hfrozen #-}
hmodify :: (forall s. Struct s h xs -> ST s ()) -> xs :& h -> xs :& h
hmodify :: (forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify f :: forall s. Struct s h xs -> ST s ()
f m :: xs :& h
m = (forall s. ST s (xs :& h)) -> xs :& h
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (xs :& h)) -> xs :& h)
-> (forall s. ST s (xs :& h)) -> xs :& h
forall a b. (a -> b) -> a -> b
$ do
Struct s h xs
s <- (xs :& h) -> ST s (Struct (PrimState (ST s)) h xs)
forall k (m :: * -> *) (xs :: [k]) (h :: k -> *).
PrimMonad m =>
(xs :& h) -> m (Struct (PrimState m) h xs)
thaw xs :& h
m
Struct s h xs -> ST s ()
forall s. Struct s h xs -> ST s ()
f Struct s h xs
s
Struct (PrimState (ST s)) h xs -> ST s (xs :& h)
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]).
PrimMonad m =>
Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze Struct s h xs
Struct (PrimState (ST s)) h xs
s
{-# INLINE[0] hmodify #-}
{-# RULES "hmodify/batch" forall
(a :: forall s. Struct s h xs -> ST s ())
(b :: forall s. Struct s h xs -> ST s ())
(x :: xs :& h). hmodify b (hmodify a x) = hmodify (\s -> a s >> b s) x #-}
instance (Corepresentable p, Comonad (Corep p), Functor f) => Extensible f p (:&) where
pieceAt :: Membership xs x -> Optic' p f (xs :& h) (h x)
pieceAt i :: Membership xs x
i pafb :: p (h x) (f (h x))
pafb = (Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h))
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h)))
-> (Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h))
forall a b. (a -> b) -> a -> b
$ \ws :: Corep p (xs :& h)
ws -> (xs :& h) -> h x -> xs :& h
sbt (Corep p (xs :& h) -> xs :& h
forall (w :: * -> *) a. Comonad w => w a -> a
extract Corep p (xs :& h)
ws) (h x -> xs :& h) -> f (h x) -> f (xs :& h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (h x) (f (h x)) -> Corep p (h x) -> f (h x)
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p (h x) (f (h x))
pafb (Membership xs x -> (xs :& h) -> h x
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs x
i ((xs :& h) -> h x) -> Corep p (xs :& h) -> Corep p (h x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Corep p (xs :& h)
ws) where
sbt :: (xs :& h) -> h x -> xs :& h
sbt xs :: xs :& h
xs !h x
x = (forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
forall k (h :: k -> *) (xs :: [k]).
(forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify (\s :: Struct s h xs
s -> Struct (PrimState (ST s)) h xs -> Membership xs x -> h x -> ST s ()
forall k (m :: * -> *) (h :: k -> *) (xs :: [k]) (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set Struct s h xs
Struct (PrimState (ST s)) h xs
s Membership xs x
i h x
x) xs :& h
xs
{-# INLINE pieceAt #-}