module Indigo.Internal.Expr.Decompose
( decomposeExpr
, deepDecomposeCompose
, ExprDecomposition (..)
, IsObject
) where
import Prelude
import Data.Constraint (Dict(..))
import Data.Vinyl.TypeLevel
import Indigo.Internal.Expr.Compilation
import Indigo.Internal.Expr.Types
import Indigo.Internal.Lookup
import Indigo.Internal.Object
import Indigo.Internal.SIS
import Indigo.Internal.State
import Indigo.Internal.Var
import Indigo.Lorentz
import qualified Lorentz.ADT as L
import qualified Lorentz.Instr as L
import Michelson.Typed.Haskell.Instr.Product (GetFieldType)
import Util.Type
type SIS' stk a = RefId -> StackVars stk -> (a, RefId, SomeGenCode stk)
deepDecomposeCompose
:: forall a inp . IsObject a
=> SIS' (a : inp) (Object a)
deepDecomposeCompose :: SIS' (a : inp) (Object a)
deepDecomposeCompose
| Just Dict <- IsObject a => Maybe (Dict (ComplexObjectC a))
forall a. IsObject a => Maybe (Dict (ComplexObjectC a))
complexObjectDict @a = \refId :: RefId
refId st :: StackVars (a : inp)
st ->
let decomposedSt :: StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp)
decomposedSt = (StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp),
(MapGFT a (GFieldNames (Rep a)) ++ inp) :-> inp)
-> StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp)
forall a b. (a, b) -> a
fst (forall (inp :: [*]).
(KnownList (MapGFT a (GFieldNames (Rep a))),
AllConstrained KnownValue (MapGFT a (GFieldNames (Rep a)))) =>
StackVars inp
-> (StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp),
(MapGFT a (GFieldNames (Rep a)) ++ inp) :-> inp)
forall (rs :: [*]) (inp :: [*]).
(KnownList rs, AllConstrained KnownValue rs) =>
StackVars inp -> (StackVars (rs ++ inp), (rs ++ inp) :-> inp)
noRefGenCode @(FieldTypes a) (StackVars inp
-> (StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp),
(MapGFT a (GFieldNames (Rep a)) ++ inp) :-> inp))
-> StackVars inp
-> (StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp),
(MapGFT a (GFieldNames (Rep a)) ++ inp) :-> inp)
forall a b. (a -> b) -> a -> b
$ StackVars (a : inp) -> StackVars inp
forall a (inp :: [*]). StackVars (a : inp) -> StackVars inp
popNoRef StackVars (a : inp)
st) in
RefId
-> StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp)
-> SIS'
(MapGFT a (GFieldNames (Rep a)) ++ inp)
(Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a))))
-> (forall (out :: [*]).
(Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a))), RefId,
GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out)
-> (Object a, RefId, SomeGenCode (a : inp)))
-> (Object a, RefId, SomeGenCode (a : inp))
forall (inp :: [*]) a r.
RefId
-> StackVars inp
-> SIS' inp a
-> (forall (out :: [*]). (a, RefId, GenCode inp out) -> r)
-> r
withStack RefId
refId StackVars (MapGFT a (GFieldNames (Rep a)) ++ inp)
decomposedSt ((KnownList (MapGFT a (GFieldNames (Rep a))),
AllConstrained IsObject (MapGFT a (GFieldNames (Rep a)))) =>
SIS'
(MapGFT a (GFieldNames (Rep a)) ++ inp)
(Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a))))
forall (flds :: [*]).
(KnownList flds, AllConstrained IsObject flds) =>
SIS' (flds ++ inp) (Rec TypedFieldObj flds)
decomposeComposeFields @(FieldTypes a)) ((forall (out :: [*]).
(Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a))), RefId,
GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out)
-> (Object a, RefId, SomeGenCode (a : inp)))
-> (Object a, RefId, SomeGenCode (a : inp)))
-> (forall (out :: [*]).
(Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a))), RefId,
GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out)
-> (Object a, RefId, SomeGenCode (a : inp)))
-> (Object a, RefId, SomeGenCode (a : inp))
forall a b. (a -> b) -> a -> b
$ \(result :: Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a)))
result, newRefId :: RefId
newRefId, gc :: GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
gc) ->
( Rec (NamedFieldObj a) (GFieldNames (Rep a)) -> Object a
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed ((forall (name :: Symbol).
TypedFieldObj (GetFieldType a name) -> NamedFieldObj a name)
-> Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a)))
-> Rec (NamedFieldObj a) (GFieldNames (Rep a))
forall a (f :: * -> *) (g :: Symbol -> *).
KnownList (ConstructorFieldNames a) =>
(forall (name :: Symbol). f (GetFieldType a name) -> g name)
-> Rec f (FieldTypes a) -> Rec g (ConstructorFieldNames a)
typedToNamedRec @a forall a (name :: Symbol).
TypedFieldObj (GetFieldType a name) -> NamedFieldObj a name
forall (name :: Symbol).
TypedFieldObj (GetFieldType a name) -> NamedFieldObj a name
typedToNamedFieldObj Rec TypedFieldObj (MapGFT a (GFieldNames (Rep a)))
result)
, RefId
newRefId
, GenCode (a : inp) out -> SomeGenCode (a : inp)
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode (a : inp) out -> SomeGenCode (a : inp))
-> GenCode (a : inp) out -> SomeGenCode (a : inp)
forall a b. (a -> b) -> a -> b
$ $WGenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode
{ gcStack :: StackVars out
gcStack = GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
-> StackVars out
forall (inp :: [*]) (out :: [*]). GenCode inp out -> StackVars out
gcStack GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
gc
, gcCode :: (a : inp) :-> out
gcCode = forall (st :: [*]).
(InstrDeconstructC a, KnownList (MapGFT a (GFieldNames (Rep a))),
ToTs (MapGFT a (GFieldNames (Rep a)))
~ ToTs (ConstructorFieldTypes a)) =>
(a : st) :-> (MapGFT a (GFieldNames (Rep a)) ++ st)
forall dt (fields :: [*]) (st :: [*]).
(InstrDeconstructC dt, KnownList fields,
ToTs fields ~ ToTs (ConstructorFieldTypes dt)) =>
(dt : st) :-> (fields ++ st)
L.deconstruct @a @(FieldTypes a) ((a : inp) :-> (MapGFT a (GFieldNames (Rep a)) ++ inp))
-> ((MapGFT a (GFieldNames (Rep a)) ++ inp) :-> out)
-> (a : inp) :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
-> (MapGFT a (GFieldNames (Rep a)) ++ inp) :-> out
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
gc
, gcClear :: out :-> (a : inp)
gcClear = GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
-> out :-> (MapGFT a (GFieldNames (Rep a)) ++ inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> out :-> inp
gcClear GenCode (MapGFT a (GFieldNames (Rep a)) ++ inp) out
gc (out :-> (MapGFT a (GFieldNames (Rep a)) ++ inp))
-> ((MapGFT a (GFieldNames (Rep a)) ++ inp) :-> (a : inp))
-> out :-> (a : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# forall (st :: [*]).
(InstrConstructC a,
ToTs (MapGFT a (GFieldNames (Rep a)))
~ ToTs (ConstructorFieldTypes a),
KnownList (MapGFT a (GFieldNames (Rep a)))) =>
(MapGFT a (GFieldNames (Rep a)) ++ st) :-> (a : st)
forall dt (fields :: [*]) (st :: [*]).
(InstrConstructC dt, ToTs fields ~ ToTs (ConstructorFieldTypes dt),
KnownList fields) =>
(fields ++ st) :-> (dt : st)
L.constructStack @a @(FieldTypes a)
}
)
| Bool
otherwise =
\refId :: RefId
refId stk :: StackVars (a : inp)
stk -> (RefId -> Object a
forall a (f :: Symbol -> *).
KnownValue a =>
RefId -> IndigoObjectF f a
Cell RefId
refId, RefId
refId RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ 1, GenCode (a : inp) (a : inp) -> SomeGenCode (a : inp)
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode (a : inp) (a : inp) -> SomeGenCode (a : inp))
-> GenCode (a : inp) (a : inp) -> SomeGenCode (a : inp)
forall a b. (a -> b) -> a -> b
$
MetaData (a : inp)
-> IndigoState (a : inp) (a : inp) -> GenCode (a : inp) (a : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (StackVars (a : inp)
-> DecomposedObjects -> GenCodeHooks -> MetaData (a : inp)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars (a : inp)
stk DecomposedObjects
forall a. Monoid a => a
mempty GenCodeHooks
emptyGenCodeHooks) (Var a -> IndigoState (a : inp) (a : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> IndigoState (x : inp) (x : inp)
assignTopVar (Var a -> IndigoState (a : inp) (a : inp))
-> Var a -> IndigoState (a : inp) (a : inp)
forall a b. (a -> b) -> a -> b
$ RefId -> Var a
forall k (a :: k). RefId -> Var a
Var RefId
refId) )
where
decomposeComposeFields
:: forall flds . (KnownList flds, AllConstrained IsObject flds)
=> SIS' (flds ++ inp) (Rec TypedFieldObj flds)
decomposeComposeFields :: SIS' (flds ++ inp) (Rec TypedFieldObj flds)
decomposeComposeFields = case KnownList flds => KList flds
forall k (l :: [k]). KnownList l => KList l
klist @flds of
KNil -> \refId :: RefId
refId stk :: StackVars (flds ++ inp)
stk -> (Rec TypedFieldObj flds
forall u (a :: u -> *). Rec a '[]
RNil, RefId
refId, GenCode inp inp -> SomeGenCode (flds ++ inp)
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode inp inp -> SomeGenCode (flds ++ inp))
-> GenCode inp inp -> SomeGenCode (flds ++ inp)
forall a b. (a -> b) -> a -> b
$ StackVars inp -> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars inp
StackVars (flds ++ inp)
stk inp :-> inp
forall (s :: [*]). s :-> s
L.nop inp :-> inp
forall (s :: [*]). s :-> s
L.nop)
KCons (Proxy x
_ :: Proxy r) (Proxy xs
_ :: Proxy rest) -> \refId :: RefId
refId st :: StackVars (flds ++ inp)
st ->
RefId
-> StackVars (xs ++ inp)
-> SIS' (xs ++ inp) (Rec TypedFieldObj xs)
-> (forall (out :: [*]).
(Rec TypedFieldObj xs, RefId, GenCode (xs ++ inp) out)
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp)))
forall (inp :: [*]) a r.
RefId
-> StackVars inp
-> SIS' inp a
-> (forall (out :: [*]). (a, RefId, GenCode inp out) -> r)
-> r
withStack RefId
refId (StackVars (x : (xs ++ inp)) -> StackVars (xs ++ inp)
forall a (inp :: [*]). StackVars (a : inp) -> StackVars inp
popNoRef StackVars (x : (xs ++ inp))
StackVars (flds ++ inp)
st) ((KnownList xs, AllConstrained IsObject xs) =>
SIS' (xs ++ inp) (Rec TypedFieldObj xs)
forall (flds :: [*]).
(KnownList flds, AllConstrained IsObject flds) =>
SIS' (flds ++ inp) (Rec TypedFieldObj flds)
decomposeComposeFields @rest) ((forall (out :: [*]).
(Rec TypedFieldObj xs, RefId, GenCode (xs ++ inp) out)
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (Rec TypedFieldObj flds, RefId, SomeGenCode (flds ++ inp)))
-> (forall (out :: [*]).
(Rec TypedFieldObj xs, RefId, GenCode (xs ++ inp) out)
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (Rec TypedFieldObj flds, RefId, SomeGenCode (flds ++ inp))
forall a b. (a -> b) -> a -> b
$ \(resultRest :: Rec TypedFieldObj xs
resultRest, refId' :: RefId
refId', restGc :: GenCode (xs ++ inp) out
restGc) ->
RefId
-> StackVars (x : out)
-> SIS' (x : out) (Object x)
-> (forall (out :: [*]).
(Object x, RefId, GenCode (x : out) out)
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp)))
forall (inp :: [*]) a r.
RefId
-> StackVars inp
-> SIS' inp a
-> (forall (out :: [*]). (a, RefId, GenCode inp out) -> r)
-> r
withStack RefId
refId' (StackVars out -> StackVars (x : out)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars out -> StackVars (x : out))
-> StackVars out -> StackVars (x : out)
forall a b. (a -> b) -> a -> b
$ GenCode (xs ++ inp) out -> StackVars out
forall (inp :: [*]) (out :: [*]). GenCode inp out -> StackVars out
gcStack GenCode (xs ++ inp) out
restGc) (forall (inp :: [*]). IsObject x => SIS' (x : inp) (Object x)
forall a (inp :: [*]). IsObject a => SIS' (a : inp) (Object a)
deepDecomposeCompose @r) ((forall (out :: [*]).
(Object x, RefId, GenCode (x : out) out)
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (forall (out :: [*]).
(Object x, RefId, GenCode (x : out) out)
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp))))
-> (Rec TypedFieldObj (x : xs), RefId,
SomeGenCode (x : (xs ++ inp)))
forall a b. (a -> b) -> a -> b
$ \(resultCur :: Object x
resultCur, newRefId :: RefId
newRefId, curGc :: GenCode (x : out) out
curGc) ->
( Object x -> TypedFieldObj x
forall a. IsObject a => Object a -> TypedFieldObj a
TypedFieldObj Object x
resultCur TypedFieldObj x
-> Rec TypedFieldObj xs -> Rec TypedFieldObj (x : xs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec TypedFieldObj xs
resultRest
, RefId
newRefId
, GenCode (x : (xs ++ inp)) out -> SomeGenCode (x : (xs ++ inp))
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode (x : (xs ++ inp)) out -> SomeGenCode (x : (xs ++ inp)))
-> GenCode (x : (xs ++ inp)) out -> SomeGenCode (x : (xs ++ inp))
forall a b. (a -> b) -> a -> b
$ $WGenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode
{ gcStack :: StackVars out
gcStack = GenCode (x : out) out -> StackVars out
forall (inp :: [*]) (out :: [*]). GenCode inp out -> StackVars out
gcStack GenCode (x : out) out
curGc
, gcCode :: (x : (xs ++ inp)) :-> out
gcCode = ((xs ++ inp) :-> out) -> (x : (xs ++ inp)) :-> (x : out)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
L.dip (GenCode (xs ++ inp) out -> (xs ++ inp) :-> out
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode GenCode (xs ++ inp) out
restGc) ((x : (xs ++ inp)) :-> (x : out))
-> ((x : out) :-> out) -> (x : (xs ++ inp)) :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# GenCode (x : out) out -> (x : out) :-> out
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode GenCode (x : out) out
curGc
, gcClear :: out :-> (x : (xs ++ inp))
gcClear = GenCode (x : out) out -> out :-> (x : out)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> out :-> inp
gcClear GenCode (x : out) out
curGc (out :-> (x : out))
-> ((x : out) :-> (x : (xs ++ inp))) -> out :-> (x : (xs ++ inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (out :-> (xs ++ inp)) -> (x : out) :-> (x : (xs ++ inp))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
L.dip (GenCode (xs ++ inp) out -> out :-> (xs ++ inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> out :-> inp
gcClear GenCode (xs ++ inp) out
restGc)
}
)
withStack
:: RefId
-> StackVars inp
-> SIS' inp a
-> (forall out . (a, RefId, GenCode inp out) -> r)
-> r
withStack :: RefId
-> StackVars inp
-> SIS' inp a
-> (forall (out :: [*]). (a, RefId, GenCode inp out) -> r)
-> r
withStack refId :: RefId
refId stk :: StackVars inp
stk sis :: SIS' inp a
sis f :: forall (out :: [*]). (a, RefId, GenCode inp out) -> r
f = case SIS' inp a
sis RefId
refId StackVars inp
stk of
(res :: a
res, newRefId :: RefId
newRefId, SomeGenCode genCode :: GenCode inp out
genCode) -> (a, RefId, GenCode inp out) -> r
forall (out :: [*]). (a, RefId, GenCode inp out) -> r
f (a
res, RefId
newRefId, GenCode inp out
genCode)
data ExprDecomposition inp a where
ExprFields :: Rec Expr (FieldTypes a) -> ExprDecomposition inp a
Deconstructed :: IndigoState inp (FieldTypes a ++ inp) -> ExprDecomposition inp a
decomposeExpr :: ComplexObjectC a => DecomposedObjects -> Expr a -> ExprDecomposition inp a
decomposeExpr :: DecomposedObjects -> Expr a -> ExprDecomposition inp a
decomposeExpr _ (ConstructWithoutNamed _ fields :: Rec Expr (FieldTypes a)
fields) = Rec Expr (FieldTypes a) -> ExprDecomposition inp a
forall a (inp :: [*]).
Rec Expr (FieldTypes a) -> ExprDecomposition inp a
ExprFields Rec Expr (FieldTypes a)
fields
decomposeExpr objs :: DecomposedObjects
objs (V v :: Var a
v) = DecomposedObjects
-> Var a
-> (Object a -> ExprDecomposition inp a)
-> ExprDecomposition inp a
forall a r.
KnownValue a =>
DecomposedObjects -> Var a -> (Object a -> r) -> r
withObject DecomposedObjects
objs Var a
v ((Object a -> ExprDecomposition inp a) -> ExprDecomposition inp a)
-> (Object a -> ExprDecomposition inp a) -> ExprDecomposition inp a
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol).
NamedFieldObj a name -> Expr (GetFieldType a name))
-> Object a -> ExprDecomposition inp a
forall a (inp :: [*]) (f :: Symbol -> *).
ComplexObjectC a =>
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> ExprDecomposition inp a
decomposeObjectF forall x (name :: Symbol).
NamedFieldObj x name -> Expr (GetFieldType x name)
forall (name :: Symbol).
NamedFieldObj a name -> Expr (GetFieldType a name)
namedToExpr
decomposeExpr objs :: DecomposedObjects
objs (ObjMan objMan :: ObjectManipulation a
objMan) = case DecomposedObjects
-> ObjectManipulation a -> ObjManipulationRes inp a
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs ObjectManipulation a
objMan of
StillObject obj :: ObjectExpr a
obj -> (forall (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name))
-> ObjectExpr a -> ExprDecomposition inp a
forall a (inp :: [*]) (f :: Symbol -> *).
ComplexObjectC a =>
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> ExprDecomposition inp a
decomposeObjectF forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
forall (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr ObjectExpr a
obj
OnStack comp :: IndigoState inp (a : inp)
comp -> IndigoState inp (a : inp) -> ExprDecomposition inp a
forall a (inp :: [*]).
ComplexObjectC a =>
IndigoState inp (a : inp) -> ExprDecomposition inp a
deconstructOnStack IndigoState inp (a : inp)
comp
decomposeExpr _ ex :: Expr a
ex = IndigoState inp (a : inp) -> ExprDecomposition inp a
forall a (inp :: [*]).
ComplexObjectC a =>
IndigoState inp (a : inp) -> ExprDecomposition inp a
deconstructOnStack (IndigoState inp (a : inp) -> ExprDecomposition inp a)
-> IndigoState inp (a : inp) -> ExprDecomposition inp a
forall a b. (a -> b) -> a -> b
$ Expr a -> IndigoState inp (a : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr a
ex
decomposeObjectF
:: forall a inp f . ComplexObjectC a
=> (forall name . f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a
-> ExprDecomposition inp a
decomposeObjectF :: (forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> ExprDecomposition inp a
decomposeObjectF _ (Cell refId :: RefId
refId) =
IndigoState inp (a : inp) -> ExprDecomposition inp a
forall a (inp :: [*]).
ComplexObjectC a =>
IndigoState inp (a : inp) -> ExprDecomposition inp a
deconstructOnStack (IndigoState inp (a : inp) -> ExprDecomposition inp a)
-> IndigoState inp (a : inp) -> ExprDecomposition inp a
forall a b. (a -> b) -> a -> b
$
(MetaData inp -> GenCode inp (a : inp))
-> IndigoState inp (a : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (a : inp))
-> IndigoState inp (a : inp))
-> (MetaData inp -> GenCode inp (a : inp))
-> IndigoState inp (a : inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md -> StackVars (a : inp)
-> (inp :-> (a : inp))
-> ((a : inp) :-> inp)
-> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (a : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (a : inp))
-> StackVars inp -> StackVars (a : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) (RefId -> StackVars inp -> inp :-> (a : inp)
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> stk :-> (a : stk)
varActionGet @a RefId
refId (StackVars inp -> inp :-> (a : inp))
-> StackVars inp -> inp :-> (a : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) (a : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop
decomposeObjectF unF :: forall (name :: Symbol). f name -> Expr (GetFieldType a name)
unF (Decomposed fields :: Rec f (ConstructorFieldNames a)
fields) =
Rec Expr (FieldTypes a) -> ExprDecomposition inp a
forall a (inp :: [*]).
Rec Expr (FieldTypes a) -> ExprDecomposition inp a
ExprFields (Rec Expr (FieldTypes a) -> ExprDecomposition inp a)
-> Rec Expr (FieldTypes a) -> ExprDecomposition inp a
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> Rec f (ConstructorFieldNames a) -> Rec Expr (FieldTypes a)
forall a (f :: Symbol -> *) (g :: * -> *).
(forall (name :: Symbol). f name -> g (GetFieldType a name))
-> Rec f (ConstructorFieldNames a) -> Rec g (FieldTypes a)
namedToTypedRec @a forall (name :: Symbol). f name -> Expr (GetFieldType a name)
unF Rec f (ConstructorFieldNames a)
fields
deconstructOnStack
:: forall a inp . ComplexObjectC a
=> IndigoState inp (a : inp)
-> ExprDecomposition inp a
deconstructOnStack :: IndigoState inp (a : inp) -> ExprDecomposition inp a
deconstructOnStack fetchFld :: IndigoState inp (a : inp)
fetchFld =
IndigoState inp (FieldTypes a ++ inp) -> ExprDecomposition inp a
forall (inp :: [*]) a.
IndigoState inp (FieldTypes a ++ inp) -> ExprDecomposition inp a
Deconstructed (IndigoState inp (FieldTypes a ++ inp) -> ExprDecomposition inp a)
-> IndigoState inp (FieldTypes a ++ inp) -> ExprDecomposition inp a
forall a b. (a -> b) -> a -> b
$ (MetaData inp -> GenCode inp (FieldTypes a ++ inp))
-> IndigoState inp (FieldTypes a ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (FieldTypes a ++ inp))
-> IndigoState inp (FieldTypes a ++ inp))
-> (MetaData inp -> GenCode inp (FieldTypes a ++ inp))
-> IndigoState inp (FieldTypes a ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
let (newSt :: StackVars (FieldTypes a ++ inp)
newSt, clean :: (FieldTypes a ++ inp) :-> inp
clean) = StackVars inp
-> (StackVars (FieldTypes a ++ inp), (FieldTypes a ++ inp) :-> inp)
forall (rs :: [*]) (inp :: [*]).
(KnownList rs, AllConstrained KnownValue rs) =>
StackVars inp -> (StackVars (rs ++ inp), (rs ++ inp) :-> inp)
noRefGenCode @(FieldTypes a) (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) in
StackVars (FieldTypes a ++ inp)
-> (inp :-> (FieldTypes a ++ inp))
-> ((FieldTypes a ++ inp) :-> inp)
-> GenCode inp (FieldTypes a ++ inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars (FieldTypes a ++ inp)
newSt (GenCode inp (a : inp) -> inp :-> (a : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (IndigoState inp (a : inp) -> MetaData inp -> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState IndigoState inp (a : inp)
fetchFld MetaData inp
md) (inp :-> (a : inp))
-> ((a : inp) :-> (FieldTypes a ++ inp))
-> inp :-> (FieldTypes a ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# forall (st :: [*]).
(InstrDeconstructC a, KnownList (FieldTypes a),
ToTs (FieldTypes a) ~ ToTs (ConstructorFieldTypes a)) =>
(a : st) :-> (FieldTypes a ++ st)
forall dt (fields :: [*]) (st :: [*]).
(InstrDeconstructC dt, KnownList fields,
ToTs fields ~ ToTs (ConstructorFieldTypes dt)) =>
(dt : st) :-> (fields ++ st)
L.deconstruct @a @(FieldTypes a)) (FieldTypes a ++ inp) :-> inp
clean
noRefGenCode
:: forall rs inp . (KnownList rs, AllConstrained KnownValue rs)
=> StackVars inp -> (StackVars (rs ++ inp), (rs ++ inp) :-> inp)
noRefGenCode :: StackVars inp -> (StackVars (rs ++ inp), (rs ++ inp) :-> inp)
noRefGenCode md :: StackVars inp
md = case KnownList rs => KList rs
forall k (l :: [k]). KnownList l => KList l
klist @rs of
KNil -> (StackVars inp
StackVars (rs ++ inp)
md, (rs ++ inp) :-> inp
forall (s :: [*]). s :-> s
L.nop)
KCons Proxy (Proxy xs
_ :: Proxy rest) -> (StackVars (xs ++ inp) -> StackVars (x : (xs ++ inp)))
-> (((xs ++ inp) :-> inp) -> (x : (xs ++ inp)) :-> inp)
-> (StackVars (xs ++ inp), (xs ++ inp) :-> inp)
-> (StackVars (x : (xs ++ inp)), (x : (xs ++ inp)) :-> inp)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap StackVars (xs ++ inp) -> StackVars (x : (xs ++ inp))
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef ((x : (xs ++ inp)) :-> (xs ++ inp)
forall a (s :: [*]). (a : s) :-> s
L.drop ((x : (xs ++ inp)) :-> (xs ++ inp))
-> ((xs ++ inp) :-> inp) -> (x : (xs ++ inp)) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#) (StackVars inp -> (StackVars (xs ++ inp), (xs ++ inp) :-> inp)
forall (rs :: [*]) (inp :: [*]).
(KnownList rs, AllConstrained KnownValue rs) =>
StackVars inp -> (StackVars (rs ++ inp), (rs ++ inp) :-> inp)
noRefGenCode @rest StackVars inp
md)