{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Indigo.Backend.Conditional
( if_
, ifSome
, ifRight
, ifCons
, IfConstraint
) where
import qualified Data.Kind as Kind
import qualified GHC.TypeLits as Lit
import Util.Type (type (++))
import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Internal hiding ((<>))
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import qualified Lorentz.Macro as L
type family CompareBranchesResults (a :: Kind.Type) (b :: Kind.Type) :: Constraint where
CompareBranchesResults x x = ()
CompareBranchesResults x y = Lit.TypeError
('Lit.Text " Result types of if branches diverged: "
'Lit.:<>: 'Lit.ShowType x 'Lit.:<>: ('Lit.Text " against ") 'Lit.:<>: 'Lit.ShowType y
)
type IfConstraint a b =
( ScopeCodeGen a
, ScopeCodeGen b
, CompareBranchesResults (RetExprs a) (RetExprs b)
, RetVars a ~ RetVars b
, RetOutStack a ~ RetOutStack b
)
if_
:: forall inp a b . IfConstraint a b
=> Expr Bool
-> SomeIndigoState inp
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
if_ :: Expr Bool
-> SomeIndigoState inp
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
if_ e :: Expr Bool
e t :: SomeIndigoState inp
t retA :: a
retA f :: SomeIndigoState inp
f retB :: b
retB retVars :: RetVars a
retVars = (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp))
-> (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{..} ->
let cde :: inp :-> (Bool : inp)
cde = GenCode inp (Bool : inp) -> inp :-> (Bool : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (Bool : inp) -> inp :-> (Bool : inp))
-> GenCode inp (Bool : inp) -> inp :-> (Bool : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (Bool : inp) -> GenCode inp (Bool : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr Bool -> IndigoState inp (Bool : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr Bool
e) in
SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
t MetaData inp
md ((forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc1 :: GenCode inp out
gc1 ->
SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
f MetaData inp
md ((forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc2 :: GenCode inp out
gc2 ->
StackVars inp
-> RetVars a
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @a StackVars inp
mdStack RetVars a
retVars ((inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (RetVars a -> Text -> Expr Bool -> Text
forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars "if" Expr Bool
e) ((inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$
MetaData inp
-> Text -> (inp :-> (Bool : inp)) -> inp :-> (Bool : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr Bool -> Text
forall ret. ReturnableValue ret => ret -> Text
prettyRet Expr Bool
e) inp :-> (Bool : inp)
cde (inp :-> (Bool : inp))
-> ((Bool : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (Bool : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (s :: [*]) (s' :: [*]).
(s :-> s') -> (s :-> s') -> (Bool : s) :-> s'
L.if_ ((StackVars out -> MetaData out)
-> GenCode inp out -> a -> inp :-> (RetOutStack a ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode inp out
gc1 a
retA) ((StackVars out -> MetaData out)
-> GenCode inp out
-> b
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode inp out
gc2 b
retB)
ifSome
:: forall inp x a b . (IfConstraint a b, KnownValue x)
=> Expr (Maybe x)
-> Var x
-> SomeIndigoState (x : inp)
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
ifSome :: Expr (Maybe x)
-> Var x
-> SomeIndigoState (x : inp)
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
ifSome e :: Expr (Maybe x)
e varX :: Var x
varX t :: SomeIndigoState (x : inp)
t retA :: a
retA f :: SomeIndigoState inp
f retB :: b
retB retVars :: RetVars a
retVars = (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp))
-> (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{..} ->
let cde :: inp :-> (Maybe x : inp)
cde = GenCode inp (Maybe x : inp) -> inp :-> (Maybe x : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (Maybe x : inp) -> inp :-> (Maybe x : inp))
-> GenCode inp (Maybe x : inp) -> inp :-> (Maybe x : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (Maybe x : inp) -> GenCode inp (Maybe x : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr (Maybe x) -> IndigoState inp (Maybe x : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr (Maybe x)
e) in
let mdJust :: MetaData (x : inp)
mdJust = Var x -> MetaData inp -> MetaData (x : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var x
varX MetaData inp
md in
SomeIndigoState (x : inp)
-> MetaData (x : inp)
-> (forall (out :: [*]).
GenCode (x : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (x : inp)
t MetaData (x : inp)
mdJust ((forall (out :: [*]).
GenCode (x : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode (x : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc1 :: GenCode (x : inp) out
gc1 ->
SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
f MetaData inp
md ((forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc2 :: GenCode inp out
gc2 ->
StackVars inp
-> RetVars a
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @a StackVars inp
mdStack RetVars a
retVars ((inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (RetVars a -> Text -> Expr (Maybe x) -> Text
forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars "ifSome" Expr (Maybe x)
e) ((inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$
MetaData inp
-> Text -> (inp :-> (Maybe x : inp)) -> inp :-> (Maybe x : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr (Maybe x) -> Text
forall ret. ReturnableValue ret => ret -> Text
prettyRet Expr (Maybe x)
e) inp :-> (Maybe x : inp)
cde (inp :-> (Maybe x : inp))
-> ((Maybe x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((x : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (Maybe x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a (s :: [*]) (s' :: [*]).
((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s'
L.ifSome
( (StackVars out -> MetaData out)
-> GenCode (x : inp) out
-> a
-> (x : inp) :-> (RetOutStack a ++ (x : inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode (x : inp) out
gc1 a
retA ((x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ (x : inp)))
-> ((RetOutStack' (ClassifyReturnValue b) b ++ (x : inp))
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (x : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((x : inp) :-> inp)
-> (RetOutStack a ++ (x : inp)) :-> (RetOutStack a ++ inp)
forall (retKind :: BranchRetKind) ret (xs :: [*]) (inp :: [*]).
ScopeCodeGen' retKind ret =>
(xs :-> inp)
-> (RetOutStack' retKind ret ++ xs)
:-> (RetOutStack' retKind ret ++ inp)
liftClear' @(ClassifyReturnValue a) @a @(x : inp) @inp (x : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop
)
((StackVars out -> MetaData out)
-> GenCode inp out
-> b
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode inp out
gc2 b
retB)
ifRight
:: forall inp r l a b . (IfConstraint a b, KnownValue r, KnownValue l)
=> Expr (Either l r)
-> Var r
-> SomeIndigoState (r : inp)
-> a
-> Var l
-> SomeIndigoState (l : inp)
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
ifRight :: Expr (Either l r)
-> Var r
-> SomeIndigoState (r : inp)
-> a
-> Var l
-> SomeIndigoState (l : inp)
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
ifRight e :: Expr (Either l r)
e varR :: Var r
varR r :: SomeIndigoState (r : inp)
r retA :: a
retA varL :: Var l
varL l :: SomeIndigoState (l : inp)
l retB :: b
retB retVars :: RetVars a
retVars = (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp))
-> (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{..} ->
let
cde :: inp :-> (Either l r : inp)
cde = GenCode inp (Either l r : inp) -> inp :-> (Either l r : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (Either l r : inp) -> inp :-> (Either l r : inp))
-> GenCode inp (Either l r : inp) -> inp :-> (Either l r : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (Either l r : inp)
-> GenCode inp (Either l r : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr (Either l r) -> IndigoState inp (Either l r : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr (Either l r)
e)
mdRight :: MetaData (r : inp)
mdRight = Var r -> MetaData inp -> MetaData (r : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var r
varR MetaData inp
md
mdLeft :: MetaData (l : inp)
mdLeft = Var l -> MetaData inp -> MetaData (l : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var l
varL MetaData inp
md
in
SomeIndigoState (r : inp)
-> MetaData (r : inp)
-> (forall (out :: [*]).
GenCode (r : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (r : inp)
r MetaData (r : inp)
mdRight ((forall (out :: [*]).
GenCode (r : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode (r : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc1 :: GenCode (r : inp) out
gc1 ->
SomeIndigoState (l : inp)
-> MetaData (l : inp)
-> (forall (out :: [*]).
GenCode (l : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (l : inp)
l MetaData (l : inp)
mdLeft ((forall (out :: [*]).
GenCode (l : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode (l : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc2 :: GenCode (l : inp) out
gc2 ->
StackVars inp
-> RetVars a
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @a StackVars inp
mdStack RetVars a
retVars ((inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (RetVars a -> Text -> Expr (Either l r) -> Text
forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars "ifRight" Expr (Either l r)
e) ((inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$
MetaData inp
-> Text
-> (inp :-> (Either l r : inp))
-> inp :-> (Either l r : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr (Either l r) -> Text
forall ret. ReturnableValue ret => ret -> Text
prettyRet Expr (Either l r)
e) inp :-> (Either l r : inp)
cde (inp :-> (Either l r : inp))
-> ((Either l r : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((r : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> ((l : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (Either l r : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall b (s :: [*]) (s' :: [*]) a.
((b : s) :-> s') -> ((a : s) :-> s') -> (Either a b : s) :-> s'
L.ifRight
( (StackVars out -> MetaData out)
-> GenCode (r : inp) out
-> a
-> (r : inp) :-> (RetOutStack a ++ (r : inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode (r : inp) out
gc1 a
retA ((r : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ (r : inp)))
-> ((RetOutStack' (ClassifyReturnValue b) b ++ (r : inp))
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (r : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((r : inp) :-> inp)
-> (RetOutStack a ++ (r : inp)) :-> (RetOutStack a ++ inp)
forall (retKind :: BranchRetKind) ret (xs :: [*]) (inp :: [*]).
ScopeCodeGen' retKind ret =>
(xs :-> inp)
-> (RetOutStack' retKind ret ++ xs)
:-> (RetOutStack' retKind ret ++ inp)
liftClear' @(ClassifyReturnValue a) @a @(r : inp) @inp (r : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop
)
( (StackVars out -> MetaData out)
-> GenCode (l : inp) out
-> b
-> (l : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ (l : inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode (l : inp) out
gc2 b
retB ((l : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ (l : inp)))
-> ((RetOutStack' (ClassifyReturnValue b) b ++ (l : inp))
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (l : inp) :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((l : inp) :-> inp)
-> (RetOutStack' (ClassifyReturnValue b) b ++ (l : inp))
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (retKind :: BranchRetKind) ret (xs :: [*]) (inp :: [*]).
ScopeCodeGen' retKind ret =>
(xs :-> inp)
-> (RetOutStack' retKind ret ++ xs)
:-> (RetOutStack' retKind ret ++ inp)
liftClear' @(ClassifyReturnValue b) @b @(l : inp) @inp (l : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop
)
ifCons
:: forall inp x a b . (IfConstraint a b, KnownValue x)
=> Expr (List x)
-> Var x
-> Var (List x)
-> SomeIndigoState (x : List x : inp)
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
ifCons :: Expr (List x)
-> Var x
-> Var (List x)
-> SomeIndigoState (x : List x : inp)
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
ifCons e :: Expr (List x)
e vx :: Var x
vx vlx :: Var (List x)
vlx t :: SomeIndigoState (x : List x : inp)
t retA :: a
retA f :: SomeIndigoState inp
f retB :: b
retB retVars :: RetVars a
retVars = (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp))
-> (MetaData inp
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> IndigoState inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{..} ->
let
cde :: inp :-> (List x : inp)
cde = GenCode inp (List x : inp) -> inp :-> (List x : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (List x : inp) -> inp :-> (List x : inp))
-> GenCode inp (List x : inp) -> inp :-> (List x : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (List x : inp) -> GenCode inp (List x : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr (List x) -> IndigoState inp (List x : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr (List x)
e)
mdList :: MetaData (List x : inp)
mdList = Var (List x) -> MetaData inp -> MetaData (List x : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var (List x)
vlx MetaData inp
md
mdVal :: MetaData (x : List x : inp)
mdVal = Var x -> MetaData (List x : inp) -> MetaData (x : List x : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var x
vx MetaData (List x : inp)
mdList
in
SomeIndigoState (x : List x : inp)
-> MetaData (x : List x : inp)
-> (forall (out :: [*]).
GenCode (x : List x : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (x : List x : inp)
t MetaData (x : List x : inp)
mdVal ((forall (out :: [*]).
GenCode (x : List x : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode (x : List x : inp) out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc1 :: GenCode (x : List x : inp) out
gc1 ->
SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
f MetaData inp
md ((forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (forall (out :: [*]).
GenCode inp out
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ \gc2 :: GenCode inp out
gc2 ->
StackVars inp
-> RetVars a
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @a StackVars inp
mdStack RetVars a
retVars ((inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (RetVars a -> Text -> Expr (List x) -> Text
forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars "ifCons" Expr (List x)
e) ((inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$
MetaData inp
-> Text -> (inp :-> (List x : inp)) -> inp :-> (List x : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr (List x) -> Text
forall ret. ReturnableValue ret => ret -> Text
prettyRet Expr (List x)
e) inp :-> (List x : inp)
cde (inp :-> (List x : inp))
-> ((List x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((x : List x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (List x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall a (s :: [*]) (s' :: [*]).
((a : List a : s) :-> s') -> (s :-> s') -> (List a : s) :-> s'
L.ifCons
( (StackVars out -> MetaData out)
-> GenCode (x : List x : inp) out
-> a
-> (x : List x : inp) :-> (RetOutStack a ++ (x : List x : inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode (x : List x : inp) out
gc1 a
retA ((x : List x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ (x : List x : inp)))
-> ((RetOutStack' (ClassifyReturnValue b) b ++ (x : List x : inp))
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp))
-> (x : List x : inp)
:-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((x : List x : inp) :-> inp)
-> (RetOutStack a ++ (x : List x : inp)) :-> (RetOutStack a ++ inp)
forall (retKind :: BranchRetKind) ret (xs :: [*]) (inp :: [*]).
ScopeCodeGen' retKind ret =>
(xs :-> inp)
-> (RetOutStack' retKind ret ++ xs)
:-> (RetOutStack' retKind ret ++ inp)
liftClear' @(ClassifyReturnValue a) @a @(x : List x : inp) @inp ((x : List x : inp) :-> (List x : inp)
forall a (s :: [*]). (a : s) :-> s
L.drop ((x : List x : inp) :-> (List x : inp))
-> ((List x : inp) :-> inp) -> (x : List x : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (List x : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop))
((StackVars out -> MetaData out)
-> GenCode inp out
-> b
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode inp out
gc2 b
retB)