{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns, BangPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MagicHash, UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Struct
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
-- Mutable structs
------------------------------------------------------------------------
module Data.Extensible.Struct (
  -- * Mutable struct
  Struct
  , set
  , get
  , new
  , newRepeat
  , newFor
  , newFromHList
  , WrappedPointer(..)
  , (-$>)
  -- ** Atomic operations
  , atomicModify
  , atomicModify'
  , atomicModify_
  , atomicModify'_
  -- * Immutable product
  , (:&)
  , (:*)
  , 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
#if __GLASGOW_HASKELL__ >= 900
import Unsafe.Coerce
#endif

-- | Mutable type-indexed struct.
data Struct s (h :: k -> Type) (xs :: [k]) = Struct (SmallMutableArray# s Any)

-- | Write a value in a 'Struct'.
set :: PrimMonad m => Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set :: forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k])
       (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
set (Struct SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# Int#
i) h x
e = (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \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)
forall a b. a -> b
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i h x
e State# (PrimState m)
s of
    State# (PrimState m)
s' -> (# State# (PrimState m)
s', () #)
{-# INLINE set #-}

-- | Read a value from a 'Struct'.
get :: PrimMonad m => Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get :: forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k])
       (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> m (h x)
get (Struct SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# Int#
i) = (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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 #)
forall a b. a -> b
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i
{-# INLINE get #-}

-- | Atomically modify an element in a 'Struct'.
atomicModify :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify :: forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k])
       (x :: k) a.
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify (Struct SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# Int#
i) h x -> (h x, a)
f = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) Any
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), Any #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i State# (PrimState m)
s0 of
    (# State# (PrimState m)
s, 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 Any
x State# (PrimState m)
s = let p :: (Any, a)
p = (h x -> (h x, a)) -> Any -> (Any, a)
forall a b. a -> b
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 a.
SmallMutableArray# d a
-> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
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
        (# State# (PrimState m)
s', Int#
b, Any
y #) -> case Int#
b of
          Int#
0# -> (# State# (PrimState m)
s', (Any, a) -> a
forall a b. (a, b) -> b
snd (Any, a)
p #)
          Int#
_ -> Any -> State# (PrimState m) -> (# State# (PrimState m), a #)
retry Any
y State# (PrimState m)
s'
{-# INLINE atomicModify #-}

-- | Strict version of 'atomicModify'.
atomicModify' :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> (h x, a)) -> m a
atomicModify' :: forall {k} (m :: Type -> Type) (h :: k -> Type) (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 h x -> (h x, a)
f = Struct (PrimState m) h xs
-> Membership xs x -> (h x -> (h x, a)) -> m a
forall {k} (m :: Type -> Type) (h :: k -> Type) (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
  (\h x
x -> let (h x
y, a
a) = h x -> (h x, a)
f h x
x in (h x
y, h x
y h x -> a -> a
forall a b. a -> b -> b
`seq` a
a))
  m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m a
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$!)
{-# INLINE atomicModify' #-}

-- | Apply a function to an element atomically.
atomicModify_ :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ :: forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k])
       (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify_ (Struct SmallMutableArray# (PrimState m) Any
m) (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# Int#
i) h x -> h x
f = (State# (PrimState m) -> (# State# (PrimState m), h x #))
-> m (h x)
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) Any
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), Any #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i State# (PrimState m)
s0 of
    (# State# (PrimState m)
s, 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 Any
x State# (PrimState m)
s = case SmallMutableArray# (PrimState m) Any
-> Int#
-> Any
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), Int#, Any #)
forall d a.
SmallMutableArray# d a
-> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# SmallMutableArray# (PrimState m) Any
m Int#
i Any
x ((h x -> h x) -> Any -> Any
forall a b. a -> b
unsafeCoerce# h x -> h x
f Any
x) State# (PrimState m)
s of
      (# State# (PrimState m)
s', Int#
b, Any
y #) -> case Int#
b of
        Int#
0# -> (# State# (PrimState m)
s', Any -> h x
forall a b. a -> b
unsafeCoerce# Any
y #)
        Int#
_ -> Any -> State# (PrimState m) -> (# State# (PrimState m), h x #)
retry Any
y State# (PrimState m)
s'
{-# INLINE atomicModify_ #-}

-- | Strict version of 'atomicModify_'.
atomicModify'_ :: PrimMonad m
  => Struct (PrimState m) h xs -> Membership xs x -> (h x -> h x) -> m (h x)
atomicModify'_ :: forall {k} (m :: Type -> Type) (h :: k -> Type) (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 = Struct (PrimState m) h xs
-> Membership xs x -> (h x -> h x) -> m (h x)
forall {k} (m :: Type -> Type) (h :: k -> Type) (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 a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (h x -> m (h x)
forall a. a -> m a
forall (m :: Type -> Type) 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'_ #-}

-- | A pointer to an element in a 'Struct'.
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 :: forall (m :: Type -> Type).
MonadIO m =>
WrappedPointer s h a -> m a
get (WrappedPointer Struct s h xs
s Membership xs x
i) = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) 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
Optic' (->) (Const a) (h x) (Repr h x)
forall k (h :: k -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: k).
(Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper (h x -> a) -> IO (h x) -> IO a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Struct (PrimState IO) h xs -> Membership xs x -> IO (h x)
forall {k} (m :: Type -> Type) (h :: k -> Type) (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 Struct s h xs
s Membership xs x
i $= :: forall (m :: Type -> Type).
MonadIO m =>
WrappedPointer s h a -> a -> m ()
$= a
v = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) 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 :: Type -> Type) (h :: k -> Type) (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
Optic' Tagged Identity (h x) (Repr h x)
forall k (h :: k -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: k).
(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 Struct s h xs
s Membership xs x
i $~ :: forall (m :: Type -> Type).
MonadIO m =>
WrappedPointer s h a -> (a -> a) -> m ()
$~ a -> a
f = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) 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 :: Type -> Type) 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 :: Type -> Type) (h :: k -> Type) (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
Optic' (->) Identity (h x) (Repr h x)
forall k (h :: k -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: k).
(Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a -> a
f
  WrappedPointer Struct s h xs
s Membership xs x
i $~! :: forall (m :: Type -> Type).
MonadIO m =>
WrappedPointer s h a -> (a -> a) -> m ()
$~! a -> a
f = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) 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 :: Type -> Type) 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 :: Type -> Type) (h :: k -> Type) (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
Optic' (->) Identity (h x) (Repr h x)
forall k (h :: k -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: k).
(Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper a -> a
f

-- | Get a 'WrappedPointer' from a name.
(-$>) :: forall k h xs v s. (Lookup xs k v) => Struct s h xs -> Proxy k -> WrappedPointer s h (Repr h (k ':> v))
Struct s h xs
s -$> :: forall {k} {v} (k :: k) (h :: Assoc k v -> Type)
       (xs :: [Assoc k v]) (v :: v) s.
Lookup xs k v =>
Struct s h xs -> Proxy k -> WrappedPointer s h (Repr h (k ':> v))
-$> Proxy k
_ = Struct s h xs
-> Membership xs (k ':> v) -> WrappedPointer s h (Repr h (k ':> v))
forall {k} s (h :: k -> Type) (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} {v} (xs :: [Assoc k v]) (k1 :: k) (v1 :: v).
Lookup xs k1 v1 =>
Membership xs (k1 ':> v1)
association :: Membership xs (k ':> v))
{-# INLINE (-$>) #-}

-- | Create a new 'Struct' using the supplied initializer.
new :: forall h m xs. (PrimMonad m, Generate xs)
  => (forall x. Membership xs x -> h x)
  -> m (Struct (PrimState m) h xs)
new :: forall {k} (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(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 :: Type -> Type) (xs :: [k]) (h :: k -> Type).
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 :: forall {k} (m :: Type -> Type) (xs :: [k]) (h :: k -> Type).
PrimMonad m =>
Dict (Generate xs)
-> (forall (x :: k). Membership xs x -> h x)
-> m (Struct (PrimState m) h xs)
newDict Dict (Generate xs)
Dict 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 -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat h x
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 r. (forall (x :: k). Membership xs x -> r -> r) -> r -> r
forall k (xs :: [k]) r.
Generate xs =>
(forall (x :: k). Membership xs x -> r -> r) -> r -> r
henumerate (\Membership xs x
i m (Struct (PrimState m) h xs)
cont -> Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall {k} (m :: Type -> Type) (h :: k -> Type) (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 a b. m a -> m b -> m b
forall (m :: Type -> Type) 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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE[0] newDict #-}

-- | Create a 'Struct' full of the specified value.
newRepeat :: forall h m xs. (PrimMonad m, Generate xs)
  => (forall x. h x)
  -> m (Struct (PrimState m) h xs)
newRepeat :: forall {k} (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat forall (x :: k). h x
x = do
  let !(I# Int#
n) = Proxy xs -> Int
forall k (xs :: [k]) (proxy :: [k] -> Type).
Generate xs =>
proxy xs -> Int
forall (proxy :: [k] -> Type). 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 a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
n (h Any -> Any
forall a b. a -> b
unsafeCoerce# h Any
forall (x :: k). h x
x) State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> Type) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)
{-# INLINE newRepeat #-}

-- | Create a new 'Struct' using the supplied initializer with a context.
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 :: forall {k} (proxy :: (k -> Constraint) -> Type)
       (c :: k -> Constraint) (h :: k -> Type) (m :: Type -> Type)
       (xs :: [k]).
(PrimMonad m, Forall c xs) =>
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) -> Type)
       (c :: k -> Constraint) (h :: k -> Type) (m :: Type -> Type)
       (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 :: forall {k} (proxy :: (k -> Constraint) -> Type)
       (c :: k -> Constraint) (h :: k -> Type) (m :: Type -> Type)
       (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)
Dict proxy c
p 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 -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
newRepeat h x
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) -> Type) (proxy' :: [k] -> Type) r.
Forall c xs =>
proxy c
-> proxy' xs
-> (forall (x :: k). c x => Membership xs x -> r -> r)
-> r
-> r
forall (proxy :: (k -> Constraint) -> Type) (proxy' :: [k] -> Type)
       r.
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) (\Membership xs x
i m (Struct (PrimState m) h xs)
cont -> Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall {k} (m :: Type -> Type) (h :: k -> Type) (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 a b. m a -> m b -> m b
forall (m :: Type -> Type) 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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE[0] newForDict #-}

-- | Create a new 'Struct' from an 'HList'.
newFromHList :: forall h m xs. PrimMonad m => L.HList h xs -> m (Struct (PrimState m) h xs)
newFromHList :: forall {k} (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
PrimMonad m =>
HList h xs -> m (Struct (PrimState m) h xs)
newFromHList HList h xs
l = do
  let !(I# Int#
size) = HList h xs -> Int
forall {k} (h :: k -> Type) (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 a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
size Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> Type) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
a #)

  let go :: Int -> L.HList h t -> m ()
      go :: forall (t :: [k]). Int -> HList h t -> m ()
go Int
_ HList h t
L.HNil = () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
      go Int
i (L.HCons h x
x HList h xs1
xs) = Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
forall {k} (m :: Type -> Type) (h :: k -> Type) (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 a b. m a -> m b -> m b
forall (m :: Type -> Type) 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
+ Int
1) HList h xs1
xs

  Int -> HList h xs -> m ()
forall (t :: [k]). Int -> HList h t -> m ()
go Int
0 HList h xs
l
  Struct (PrimState m) h xs -> m (Struct (PrimState m) h xs)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Struct (PrimState m) h xs
m
{-# NOINLINE newFromHList #-}

-- | The type of extensible products.
--
-- @(:&) :: [k] -> (k -> Type) -> Type@
--
data (s :: [k]) :& (h :: k -> Type) = HProduct (SmallArray# Any)

type h :* xs = xs :& h
{-# DEPRECATED (:*) "Use :& instead" #-}

-- | Turn 'Struct' into an immutable product. The original 'Struct' may not be used.
unsafeFreeze :: PrimMonad m => Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze :: forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k]).
PrimMonad m =>
Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze (Struct SmallMutableArray# (PrimState m) Any
m) = (State# (PrimState m) -> (# State# (PrimState m), xs :& h #))
-> m (xs :& h)
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# Any #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# (PrimState m) Any
m State# (PrimState m)
s of
  (# State# (PrimState m)
s', SmallArray# Any
a #) -> (# State# (PrimState m)
s', SmallArray# Any -> xs :& h
forall k (s :: [k]) (h :: k -> Type). SmallArray# Any -> s :& h
HProduct SmallArray# Any
a #)
{-# INLINE unsafeFreeze #-}

-- | Create a new 'Struct' from a product.
thaw :: PrimMonad m => xs :& h -> m (Struct (PrimState m) h xs)
thaw :: forall {k} (m :: Type -> Type) (xs :: [k]) (h :: k -> Type).
PrimMonad m =>
(xs :& h) -> m (Struct (PrimState m) h xs)
thaw (HProduct SmallArray# Any
ar) = (State# (PrimState m)
 -> (# State# (PrimState m), Struct (PrimState m) h xs #))
-> m (Struct (PrimState m) h xs)
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s -> case SmallArray# Any
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall a d.
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
thawSmallArray# SmallArray# Any
ar Int#
0# (SmallArray# Any -> Int#
forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# Any
ar) State# (PrimState m)
s of
  (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any
m #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> Type) (xs :: [k]).
SmallMutableArray# s Any -> Struct s h xs
Struct SmallMutableArray# (PrimState m) Any
m #)

-- | The size of a product.
hlength :: xs :& h -> Int
hlength :: forall {k} (xs :: [k]) (h :: k -> Type). (xs :& h) -> Int
hlength (HProduct SmallArray# Any
ar) = Int# -> Int
I# (SmallArray# Any -> Int#
forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# Any
ar)
{-# INLINE hlength #-}

-- | Concatenate type level lists
type family (++) (xs :: [k]) (ys :: [k]) :: [k] where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': xs ++ ys

infixr 5 ++

-- | Combine products.
happend :: xs :& h -> ys :& h -> (xs ++ ys) :& h
happend :: forall {k} (xs :: [k]) (h :: k -> Type) (ys :: [k]).
(xs :& h) -> (ys :& h) -> (xs ++ ys) :& h
happend (HProduct SmallArray# Any
lhs) (HProduct 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 a.
(State# (PrimState (ST s)) -> (# State# (PrimState (ST s)), a #))
-> ST s a
forall (m :: Type -> Type) 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
$ \State# (PrimState (ST s))
s0 ->
  let lhsSz :: Int#
lhsSz = SmallArray# Any -> Int#
forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# Any
lhs
      rhsSz :: Int#
rhsSz = SmallArray# Any -> Int#
forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# Any
rhs
  in  case Int# -> Any -> State# s -> (# State# s, SmallMutableArray# s Any #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# (Int#
lhsSz Int# -> Int# -> Int#
+# Int#
rhsSz) Any
forall a. HasCallStack => a
undefined State# s
State# (PrimState (ST s))
s0 of { (# State# s
s1, SmallMutableArray# s Any
a #) ->
      case SmallArray# Any
-> Int#
-> SmallMutableArray# s Any
-> Int#
-> Int#
-> State# s
-> State# s
forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# Any
lhs Int#
0# SmallMutableArray# s Any
a Int#
0# Int#
lhsSz State# s
s1 of { State# s
s2 ->
      case SmallArray# Any
-> Int#
-> SmallMutableArray# s Any
-> Int#
-> Int#
-> State# s
-> State# s
forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# Any
rhs Int#
0# SmallMutableArray# s Any
a Int#
lhsSz Int#
rhsSz State# s
s2 of { State# s
s3 ->
      case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallArray# Any #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# s Any
a State# s
s3 of { (# State# s
s4, SmallArray# Any
frz #) ->
      (# State# s
State# (PrimState (ST s))
s4, SmallArray# Any -> (xs ++ ys) :& h
forall k (s :: [k]) (h :: k -> Type). SmallArray# Any -> s :& h
HProduct SmallArray# Any
frz #) }}}}

infixr 5 `happend`

unsafeMembership :: Int -> Membership xs x
unsafeMembership :: forall {k} (xs :: [k]) (x :: k). Int -> Membership xs x
unsafeMembership = Int -> Membership xs x
forall a b. a -> b
unsafeCoerce#

-- | Right-associative fold of a product.
hfoldrWithIndex :: (forall x. Membership xs x -> h x -> r -> r) -> r -> xs :& h -> r
hfoldrWithIndex :: forall {k} (xs :: [k]) (h :: k -> Type) r.
(forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex forall (x :: k). Membership xs x -> h x -> r -> r
f r
r xs :& h
p = (Int -> r -> r) -> r -> [Int] -> r
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
  (\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 -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup Membership xs Any
m xs :& h
p)) r
r [Int
0..(xs :& h) -> Int
forall {k} (xs :: [k]) (h :: k -> Type). (xs :& h) -> Int
hlength xs :& h
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
{-# INLINE hfoldrWithIndex #-}

-- | Convert a product into an 'HList'.
toHList :: forall h xs. xs :& h -> L.HList h xs
toHList :: forall {k} (h :: k -> Type) (xs :: [k]). (xs :& h) -> HList h xs
toHList xs :& h
p = Int -> HList h xs
go Int
0 where
  go :: Int -> L.HList h xs
  go :: Int -> HList h xs
go Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (xs :& h) -> Int
forall {k} (xs :: [k]) (h :: k -> Type). (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 -> Type). 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 -> Type) (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 -> Type).
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
+ Int
1))

  unknownHList :: L.HList h ys -> L.HList h zs
  unknownHList :: forall (ys :: [k]) (zs :: [k]). HList h ys -> HList h zs
unknownHList = HList h ys -> HList h zs
forall a b. a -> b
unsafeCoerce#
{-# NOINLINE toHList #-}

{-# RULES "toHList/fromHList" forall x. toHList (hfrozen (newFromHList x)) = x #-}

-- | Create a new 'Struct' using the contents of a product.
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 :: forall {k} (g :: k -> Type) (h :: k -> Type) (m :: Type -> Type)
       (xs :: [k]).
PrimMonad m =>
(xs :& g)
-> (forall (x :: k). Membership xs x -> g x -> h x)
-> m (Struct (PrimState m) h xs)
newFrom hp :: xs :& g
hp@(HProduct SmallArray# Any
ar) forall (x :: k). Membership xs x -> g x -> h x
k = do
  let !n :: Int#
n = SmallArray# Any -> Int#
forall a. SmallArray# a -> 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 a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) 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
$ \State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
n Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any
a #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> Struct (PrimState m) h xs
forall k s (h :: k -> Type) (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 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 a. a -> m a
forall (m :: Type -> Type) 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 :: Type -> Type) (h :: k -> Type) (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 -> Type).
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
+ Int
1)
  Int -> m (Struct (PrimState m) h xs)
go Int
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)) #-}

-- | Get an element in a product.
hlookup :: Membership xs x -> xs :& h -> h x
hlookup :: forall {k} (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup (Membership xs x -> Int
forall k (xs :: [k]) (x :: k). Membership xs x -> Int
getMemberId -> I# Int#
i) (HProduct SmallArray# Any
ar) = case SmallArray# Any -> Int# -> (# Any #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# Any
ar Int#
i of
  (# Any
a #) -> Any -> h x
forall a b. a -> b
unsafeCoerce# Any
a
{-# INLINE hlookup #-}

-- | Create a product from an 'ST' action which returns a 'Struct'.
hfrozen :: (forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen :: forall {k} (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
hfrozen 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 a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct s h xs -> ST s (xs :& h)
Struct (PrimState (ST s)) h xs -> ST s (xs :& h)
forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k]).
PrimMonad m =>
Struct (PrimState m) h xs -> m (xs :& h)
unsafeFreeze
{-# INLINE[0] hfrozen #-}

-- | Turn a product into a 'Struct' temporarily.
hmodify :: (forall s. Struct s h xs -> ST s ()) -> xs :& h -> xs :& h
hmodify :: forall {k} (h :: k -> Type) (xs :: [k]).
(forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify forall s. Struct s h xs -> ST s ()
f 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 :: Type -> Type) (xs :: [k]) (h :: k -> Type).
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 :: Type -> Type) (h :: k -> Type) (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
  -- | A lens for a value in a known position.
  pieceAt :: forall (xs :: [k]) (h :: k -> Type) (x :: k).
ExtensibleConstr (:&) xs h x =>
Membership xs x -> Optic' p f (xs :& h) (h x)
pieceAt Membership xs x
i p (h x) (f (h x))
pafb = (Corep p (xs :& h) -> f (xs :& h)) -> p (xs :& h) (f (xs :& h))
forall d c. (Corep p d -> c) -> p d c
forall (p :: Type -> Type -> Type) 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
$ \Corep p (xs :& h)
ws -> (xs :& h) -> h x -> xs :& h
sbt (Corep p (xs :& h) -> xs :& h
forall a. Corep p a -> a
forall (w :: Type -> Type) a. Comonad w => w a -> a
extract Corep p (xs :& h)
ws) (h x -> xs :& h) -> f (h x) -> f (xs :& h)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> p (h x) (f (h x)) -> Corep p (h x) -> f (h x)
forall a b. p a b -> Corep p a -> b
forall (p :: Type -> Type -> Type) (f :: Type -> Type) 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 -> Type).
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 :: Type -> Type) 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 :& h
xs !h x
x = (forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
forall {k} (h :: k -> Type) (xs :: [k]).
(forall s. Struct s h xs -> ST s ()) -> (xs :& h) -> xs :& h
hmodify (\Struct s h xs
s -> Struct (PrimState (ST s)) h xs -> Membership xs x -> h x -> ST s ()
forall {k} (m :: Type -> Type) (h :: k -> Type) (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 #-}