{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Indigo.Backend.Scope
( BranchRetKind (..)
, ScopeCodeGen
, ScopeCodeGen' (..)
, ReturnableValue
, ReturnableValue' (..)
, RetOutStack
, RetVars
, RetExprs
, ClassifyReturnValue
, liftClear
, compileScope
, allocateVars
, finalizeStatement
) where
import qualified Data.Kind as Kind
import qualified GHC.TypeLits as Lit
import Util.Type (type (++))
import Indigo.Backend.Prelude
import Indigo.Internal.Expr
import Indigo.Internal.State
import Indigo.Internal.Var
import Indigo.Lorentz
import qualified Lorentz.Instr as L
data BranchRetKind =
Unit
| SingleVal
| Tuple
type family ClassifyReturnValue (ret :: Kind.Type) where
ClassifyReturnValue () = 'Unit
ClassifyReturnValue (_, _) = 'Tuple
ClassifyReturnValue (_, _, _) = 'Tuple
ClassifyReturnValue (_, _, _, _) =
Lit.TypeError ('Lit.Text "Tuple with 4 elements is not supported yet as returning value")
ClassifyReturnValue (_, _, _, _, _) =
Lit.TypeError ('Lit.Text "Tuple with 5 elements is not supported yet as returning value")
ClassifyReturnValue (_, _, _, _, _, _) =
Lit.TypeError ('Lit.Text "Tuple with 6 elements is not supported yet as returning value")
ClassifyReturnValue _ = 'SingleVal
class ReturnableValue' (retKind :: BranchRetKind) (ret :: Kind.Type) where
type family RetOutStack' retKind ret :: [Kind.Type]
type family RetVars' retKind ret :: Kind.Type
type family RetExprs' retKind ret :: Kind.Type
allocateVars'
:: Monad m
=> (forall (x :: Kind.Type) . m (Var x))
-> m (RetVars' retKind ret)
assignVars'
:: RetVars' retKind ret
-> StackVars inp
-> StackVars (RetOutStack' retKind ret ++ inp)
class ReturnableValue' retKind ret => ScopeCodeGen' (retKind :: BranchRetKind) (ret :: Kind.Type) where
compileScopeReturn' :: ret -> IndigoState xs (RetOutStack' retKind ret ++ xs)
liftClear' :: (xs :-> inp) -> (RetOutStack' retKind ret ++ xs :-> RetOutStack' retKind ret ++ inp)
genGcClear' :: (RetOutStack' retKind ret ++ inp) :-> inp
type RetOutStack ret = RetOutStack' (ClassifyReturnValue ret) ret
type RetVars ret = RetVars' (ClassifyReturnValue ret) ret
type RetExprs ret = RetExprs' (ClassifyReturnValue ret) ret
type ReturnableValue ret = ReturnableValue' (ClassifyReturnValue ret) ret
type ScopeCodeGen ret = ScopeCodeGen' (ClassifyReturnValue ret) ret
allocateVars
:: forall ret m . (ReturnableValue ret, Monad m)
=> (forall (x :: Kind.Type) . m (Var x))
-> m (RetVars ret)
allocateVars :: (forall x. m (Var x)) -> m (RetVars ret)
allocateVars = forall (m :: * -> *).
(ReturnableValue' (ClassifyReturnValue ret) ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
forall (retKind :: BranchRetKind) ret (m :: * -> *).
(ReturnableValue' retKind ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars' retKind ret)
allocateVars' @(ClassifyReturnValue ret) @ret
liftClear
:: forall ret inp xs . ScopeCodeGen ret
=> (xs :-> inp)
-> (RetOutStack ret ++ xs :-> RetOutStack ret ++ inp)
liftClear :: (xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
liftClear = forall (xs :: [*]) (inp :: [*]).
ScopeCodeGen' (ClassifyReturnValue ret) ret =>
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
forall (retKind :: BranchRetKind) ret (xs :: [*]) (inp :: [*]).
ScopeCodeGen' retKind ret =>
(xs :-> inp)
-> (RetOutStack' retKind ret ++ xs)
:-> (RetOutStack' retKind ret ++ inp)
liftClear' @(ClassifyReturnValue ret) @ret
compileScope
:: forall ret inp xs . ScopeCodeGen ret
=> DecomposedObjects
-> GenCode inp xs
-> ret
-> (inp :-> RetOutStack ret ++ inp)
compileScope :: DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope objs :: DecomposedObjects
objs gc :: GenCode inp xs
gc gcRet :: ret
gcRet =
GenCode inp xs -> inp :-> xs
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode GenCode inp xs
gc (inp :-> xs)
-> (xs :-> (RetOutStack ret ++ xs))
-> inp :-> (RetOutStack ret ++ xs)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
GenCode xs (RetOutStack ret ++ xs)
-> xs :-> (RetOutStack ret ++ xs)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (MetaData xs
-> IndigoState xs (RetOutStack ret ++ xs)
-> GenCode xs (RetOutStack ret ++ xs)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (StackVars xs -> DecomposedObjects -> MetaData xs
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData (GenCode inp xs -> StackVars xs
forall (inp :: [*]) (out :: [*]). GenCode inp out -> StackVars out
gcStack GenCode inp xs
gc) DecomposedObjects
objs) (ret -> IndigoState xs (RetOutStack ret ++ xs)
forall (retKind :: BranchRetKind) ret (xs :: [*]).
ScopeCodeGen' retKind ret =>
ret -> IndigoState xs (RetOutStack' retKind ret ++ xs)
compileScopeReturn' @(ClassifyReturnValue ret) ret
gcRet)) (inp :-> (RetOutStack ret ++ xs))
-> ((RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp))
-> inp :-> (RetOutStack ret ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
forall (retKind :: BranchRetKind) ret (xs :: [*]) (inp :: [*]).
ScopeCodeGen' retKind ret =>
(xs :-> inp)
-> (RetOutStack' retKind ret ++ xs)
:-> (RetOutStack' retKind ret ++ inp)
liftClear' @(ClassifyReturnValue ret) @ret (GenCode inp xs -> xs :-> inp
forall (inp :: [*]) (out :: [*]). GenCode inp out -> out :-> inp
gcClear GenCode inp xs
gc)
finalizeStatement
:: forall ret inp . ScopeCodeGen ret
=> StackVars inp
-> RetVars ret
-> (inp :-> RetOutStack ret ++ inp)
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement :: StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement md :: StackVars inp
md vars :: RetVars ret
vars code :: inp :-> (RetOutStack ret ++ inp)
code =
let newMd :: StackVars (RetOutStack ret ++ inp)
newMd = RetVars ret -> StackVars inp -> StackVars (RetOutStack ret ++ inp)
forall (retKind :: BranchRetKind) ret (inp :: [*]).
ReturnableValue' retKind ret =>
RetVars' retKind ret
-> StackVars inp -> StackVars (RetOutStack' retKind ret ++ inp)
assignVars' @(ClassifyReturnValue ret) @ret RetVars ret
vars StackVars inp
md in
StackVars (RetOutStack ret ++ inp)
-> (inp :-> (RetOutStack ret ++ inp))
-> ((RetOutStack ret ++ inp) :-> inp)
-> GenCode inp (RetOutStack ret ++ inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars (RetOutStack ret ++ inp)
newMd inp :-> (RetOutStack ret ++ inp)
code (forall (inp :: [*]).
ScopeCodeGen' (ClassifyReturnValue ret) ret =>
(RetOutStack ret ++ inp) :-> inp
forall (retKind :: BranchRetKind) ret (inp :: [*]).
ScopeCodeGen' retKind ret =>
(RetOutStack' retKind ret ++ inp) :-> inp
genGcClear' @(ClassifyReturnValue ret) @ret)
type KnownValueExpr a = (KnownValue (ExprType a), ToExpr a)
instance ReturnableValue' 'Unit () where
type RetOutStack' 'Unit () = '[]
type RetVars' 'Unit () = ()
type RetExprs' 'Unit () = ()
allocateVars' :: (forall x. m (Var x)) -> m (RetVars' 'Unit ())
allocateVars' _ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
assignVars' :: RetVars' 'Unit ()
-> StackVars inp -> StackVars (RetOutStack' 'Unit () ++ inp)
assignVars' _ md :: StackVars inp
md = StackVars inp
StackVars (RetOutStack' 'Unit () ++ inp)
md
instance ScopeCodeGen' 'Unit () where
compileScopeReturn' :: () -> IndigoState xs (RetOutStack' 'Unit () ++ xs)
compileScopeReturn' _ = IndigoState xs (RetOutStack' 'Unit () ++ xs)
forall (inp :: [*]). IndigoState inp inp
nopState
liftClear' :: (xs :-> inp)
-> (RetOutStack' 'Unit () ++ xs) :-> (RetOutStack' 'Unit () ++ inp)
liftClear' = (xs :-> inp)
-> (RetOutStack' 'Unit () ++ xs) :-> (RetOutStack' 'Unit () ++ inp)
forall a. a -> a
id
genGcClear' :: (RetOutStack' 'Unit () ++ inp) :-> inp
genGcClear' = (RetOutStack' 'Unit () ++ inp) :-> inp
forall (s :: [*]). s :-> s
L.nop
instance KnownValueExpr single => ReturnableValue' 'SingleVal single where
type RetOutStack' 'SingleVal single = '[ExprType single]
type RetVars' 'SingleVal single = Var (ExprType single)
type RetExprs' 'SingleVal single = ExprType single
allocateVars' :: (forall x. m (Var x)) -> m (RetVars' 'SingleVal single)
allocateVars' allocator :: forall x. m (Var x)
allocator = m (Var (ExprType single))
forall x. m (Var x)
allocator @(ExprType single)
assignVars' :: RetVars' 'SingleVal single
-> StackVars inp
-> StackVars (RetOutStack' 'SingleVal single ++ inp)
assignVars' = RetVars' 'SingleVal single
-> StackVars inp
-> StackVars (RetOutStack' 'SingleVal single ++ inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef
instance KnownValueExpr single => ScopeCodeGen' 'SingleVal single where
compileScopeReturn' :: single -> IndigoState xs (RetOutStack' 'SingleVal single ++ xs)
compileScopeReturn' = single -> IndigoState xs (RetOutStack' 'SingleVal single ++ xs)
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp)
compileToExpr
liftClear' :: (xs :-> inp)
-> (RetOutStack' 'SingleVal single ++ xs)
:-> (RetOutStack' 'SingleVal single ++ inp)
liftClear' = (xs :-> inp)
-> (RetOutStack' 'SingleVal single ++ xs)
:-> (RetOutStack' 'SingleVal single ++ inp)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
L.dip
genGcClear' :: (RetOutStack' 'SingleVal single ++ inp) :-> inp
genGcClear' = (RetOutStack' 'SingleVal single ++ inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
instance (KnownValueExpr x, KnownValueExpr y) => ReturnableValue' 'Tuple (x, y) where
type RetOutStack' 'Tuple (x, y) = ExprType x ': '[ExprType y]
type RetVars' 'Tuple (x, y) = (Var (ExprType x), Var (ExprType y))
type RetExprs' 'Tuple (x, y) = (ExprType x, ExprType y)
allocateVars' :: (forall x. m (Var x)) -> m (RetVars' 'Tuple (x, y))
allocateVars' allocator :: forall x. m (Var x)
allocator = (,) (Var (ExprType' (Decide x) x)
-> Var (ExprType' (Decide y) y)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y)))
-> m (Var (ExprType' (Decide x) x))
-> m (Var (ExprType' (Decide y) y)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Var (ExprType' (Decide x) x))
forall x. m (Var x)
allocator m (Var (ExprType' (Decide y) y)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y)))
-> m (Var (ExprType' (Decide y) y))
-> m (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Var (ExprType' (Decide y) y))
forall x. m (Var x)
allocator
assignVars' :: RetVars' 'Tuple (x, y)
-> StackVars inp -> StackVars (RetOutStack' 'Tuple (x, y) ++ inp)
assignVars' (var1, var2) md :: StackVars inp
md = Var (ExprType' (Decide x) x)
-> StackVars (ExprType' (Decide y) y & inp)
-> StackVars
(ExprType' (Decide x) x & (ExprType' (Decide y) y & inp))
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var (ExprType' (Decide x) x)
var1 (StackVars (ExprType' (Decide y) y & inp)
-> StackVars (RetOutStack' 'Tuple (x, y) ++ inp))
-> StackVars (ExprType' (Decide y) y & inp)
-> StackVars (RetOutStack' 'Tuple (x, y) ++ inp)
forall a b. (a -> b) -> a -> b
$ Var (ExprType' (Decide y) y)
-> StackVars inp -> StackVars (ExprType' (Decide y) y & inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var (ExprType' (Decide y) y)
var2 StackVars inp
md
instance (KnownValueExpr x, KnownValueExpr y) => ScopeCodeGen' 'Tuple (x, y) where
compileScopeReturn' :: (x, y) -> IndigoState xs (RetOutStack' 'Tuple (x, y) ++ xs)
compileScopeReturn' (e1 :: x
e1, e2 :: y
e2) = y -> IndigoState xs (ExprType' (Decide y) y : xs)
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp)
compileToExpr y
e2 IndigoState xs (ExprType' (Decide y) y : xs)
-> IndigoState
(ExprType' (Decide y) y : xs)
(ExprType' (Decide x) x & (ExprType' (Decide y) y : xs))
-> IndigoState
xs (ExprType' (Decide x) x & (ExprType' (Decide y) y : xs))
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>> x
-> IndigoState
(ExprType' (Decide y) y : xs)
(ExprType' (Decide x) x & (ExprType' (Decide y) y : xs))
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp)
compileToExpr x
e1
liftClear' :: (xs :-> inp)
-> (RetOutStack' 'Tuple (x, y) ++ xs)
:-> (RetOutStack' 'Tuple (x, y) ++ inp)
liftClear' = ((ExprType' (Decide y) y & xs) :-> (ExprType' (Decide y) y & inp))
-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & xs))
:-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & inp))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
L.dip (((ExprType' (Decide y) y & xs) :-> (ExprType' (Decide y) y & inp))
-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & xs))
:-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & inp)))
-> ((xs :-> inp)
-> (ExprType' (Decide y) y & xs)
:-> (ExprType' (Decide y) y & inp))
-> (xs :-> inp)
-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & xs))
:-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & inp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (xs :-> inp)
-> (ExprType' (Decide y) y & xs) :-> (ExprType' (Decide y) y & inp)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
L.dip
genGcClear' :: (RetOutStack' 'Tuple (x, y) ++ inp) :-> inp
genGcClear' = (ExprType' (Decide x) x & (ExprType' (Decide y) y & inp))
:-> (ExprType' (Decide y) y & inp)
forall a (s :: [*]). (a & s) :-> s
L.drop ((ExprType' (Decide x) x & (ExprType' (Decide y) y & inp))
:-> (ExprType' (Decide y) y & inp))
-> ((ExprType' (Decide y) y & inp) :-> inp)
-> (ExprType' (Decide x) x & (ExprType' (Decide y) y & inp))
:-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (ExprType' (Decide y) y & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
instance (KnownValueExpr x, KnownValueExpr y, KnownValueExpr z) => ReturnableValue' 'Tuple (x, y, z) where
type RetOutStack' 'Tuple (x, y, z) = ExprType x ': ExprType y ': '[ExprType z]
type RetVars' 'Tuple (x, y, z) = (Var (ExprType x), Var (ExprType y), Var (ExprType z))
type RetExprs' 'Tuple (x, y, z) = (ExprType x, ExprType y, ExprType z)
allocateVars' :: (forall x. m (Var x)) -> m (RetVars' 'Tuple (x, y, z))
allocateVars' allocator :: forall x. m (Var x)
allocator = (,,) (Var (ExprType' (Decide x) x)
-> Var (ExprType' (Decide y) y)
-> Var (ExprType' (Decide z) z)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y),
Var (ExprType' (Decide z) z)))
-> m (Var (ExprType' (Decide x) x))
-> m (Var (ExprType' (Decide y) y)
-> Var (ExprType' (Decide z) z)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y),
Var (ExprType' (Decide z) z)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Var (ExprType' (Decide x) x))
forall x. m (Var x)
allocator m (Var (ExprType' (Decide y) y)
-> Var (ExprType' (Decide z) z)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y),
Var (ExprType' (Decide z) z)))
-> m (Var (ExprType' (Decide y) y))
-> m (Var (ExprType' (Decide z) z)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y),
Var (ExprType' (Decide z) z)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Var (ExprType' (Decide y) y))
forall x. m (Var x)
allocator m (Var (ExprType' (Decide z) z)
-> (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y),
Var (ExprType' (Decide z) z)))
-> m (Var (ExprType' (Decide z) z))
-> m (Var (ExprType' (Decide x) x), Var (ExprType' (Decide y) y),
Var (ExprType' (Decide z) z))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Var (ExprType' (Decide z) z))
forall x. m (Var x)
allocator
assignVars' :: RetVars' 'Tuple (x, y, z)
-> StackVars inp
-> StackVars (RetOutStack' 'Tuple (x, y, z) ++ inp)
assignVars' (var1, var2, var3) md :: StackVars inp
md =
Var (ExprType' (Decide x) x)
-> StackVars
(ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))
-> StackVars
(ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var (ExprType' (Decide x) x)
var1 (StackVars
(ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))
-> StackVars
(ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))))
-> (StackVars (ExprType' (Decide z) z & inp)
-> StackVars
(ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
-> StackVars (ExprType' (Decide z) z & inp)
-> StackVars
(ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var (ExprType' (Decide y) y)
-> StackVars (ExprType' (Decide z) z & inp)
-> StackVars
(ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var (ExprType' (Decide y) y)
var2 (StackVars (ExprType' (Decide z) z & inp)
-> StackVars (RetOutStack' 'Tuple (x, y, z) ++ inp))
-> StackVars (ExprType' (Decide z) z & inp)
-> StackVars (RetOutStack' 'Tuple (x, y, z) ++ inp)
forall a b. (a -> b) -> a -> b
$ Var (ExprType' (Decide z) z)
-> StackVars inp -> StackVars (ExprType' (Decide z) z & inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var (ExprType' (Decide z) z)
var3 StackVars inp
md
instance (KnownValueExpr x, KnownValueExpr y, KnownValueExpr z) => ScopeCodeGen' 'Tuple (x, y, z) where
compileScopeReturn' :: (x, y, z) -> IndigoState xs (RetOutStack' 'Tuple (x, y, z) ++ xs)
compileScopeReturn' (e1 :: x
e1, e2 :: y
e2, e3 :: z
e3) = z -> IndigoState xs (ExprType' (Decide z) z : xs)
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp)
compileToExpr z
e3 IndigoState xs (ExprType' (Decide z) z : xs)
-> IndigoState
(ExprType' (Decide z) z : xs)
(ExprType' (Decide y) y & (ExprType' (Decide z) z : xs))
-> IndigoState
xs (ExprType' (Decide y) y & (ExprType' (Decide z) z : xs))
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>> y
-> IndigoState
(ExprType' (Decide z) z : xs)
(ExprType' (Decide y) y & (ExprType' (Decide z) z : xs))
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp)
compileToExpr y
e2 IndigoState
xs (ExprType' (Decide y) y & (ExprType' (Decide z) z : xs))
-> IndigoState
(ExprType' (Decide y) y & (ExprType' (Decide z) z : xs))
(ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z : xs)))
-> IndigoState
xs
(ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z : xs)))
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>> x
-> IndigoState
(ExprType' (Decide y) y & (ExprType' (Decide z) z : xs))
(ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z : xs)))
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp)
compileToExpr x
e1
liftClear' :: (xs :-> inp)
-> (RetOutStack' 'Tuple (x, y, z) ++ xs)
:-> (RetOutStack' 'Tuple (x, y, z) ++ inp)
liftClear' = forall (inp :: [*]) (out :: [*]) (s :: [*]) (s' :: [*]).
ConstraintDIPNLorentz (ToPeano 3) inp out s s' =>
(s :-> s') -> inp :-> out
forall (n :: Nat) (inp :: [*]) (out :: [*]) (s :: [*]) (s' :: [*]).
ConstraintDIPNLorentz (ToPeano n) inp out s s' =>
(s :-> s') -> inp :-> out
L.dipN @3
genGcClear' :: (RetOutStack' 'Tuple (x, y, z) ++ inp) :-> inp
genGcClear' = (ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
:-> (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))
forall a (s :: [*]). (a & s) :-> s
L.drop ((ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
:-> (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
-> ((ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))
:-> (ExprType' (Decide z) z & inp))
-> (ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
:-> (ExprType' (Decide z) z & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp))
:-> (ExprType' (Decide z) z & inp)
forall a (s :: [*]). (a & s) :-> s
L.drop ((ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
:-> (ExprType' (Decide z) z & inp))
-> ((ExprType' (Decide z) z & inp) :-> inp)
-> (ExprType' (Decide x) x
& (ExprType' (Decide y) y & (ExprType' (Decide z) z & inp)))
:-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (ExprType' (Decide z) z & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
compileToExpr :: ToExpr a => a -> IndigoState inp ((ExprType a) & inp)
compileToExpr :: a -> IndigoState inp (ExprType a & inp)
compileToExpr = Expr (ExprType a) -> IndigoState inp (ExprType a & inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr (Expr (ExprType a) -> IndigoState inp (ExprType a & inp))
-> (a -> Expr (ExprType a))
-> a
-> IndigoState inp (ExprType a & inp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expr (ExprType a)
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr