-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Backend conditional statements of Indigo

module Indigo.Backend.Conditional
  ( if_
  , ifSome
  , ifRight
  , ifCons
  , IfConstraint
  ) where

import Data.Kind qualified as Kind
import GHC.TypeLits qualified as Lit
import Morley.Util.Type (type (++))

import Indigo.Backend.Expr.Compilation (compileExpr)
import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Common.Expr (Expr)
import Indigo.Common.SIS (SomeIndigoState, runSIS)
import Indigo.Common.State
import Indigo.Common.Var (Var)
import Indigo.Lorentz
import Lorentz.Instr qualified as L
import Lorentz.Macro qualified 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)
  -- These constraints below are implied by the one above, but GHC needs a proof
  , RetVars a ~ RetVars b
  , RetOutStack a ~ RetOutStack b
  )

-- | If statement. All variables created inside its branches will be released
-- after the execution leaves the scope in which they were created.
if_
  :: forall inp a b . IfConstraint a b
  => Expr Bool
  -- ^ Expression for the control flow
  -> SomeIndigoState inp
  -- ^ Code block for the positive branch
  -> a
  -- ^ Return value(s) of the positive branch
  -> SomeIndigoState inp
  -- ^ Code block for the negative branch
  -> b
  -- ^ Return value(s) of the negative branch
  -> RetVars a
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack a ++ inp)
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
e SomeIndigoState inp
t a
retA SomeIndigoState inp
f b
retB RetVars a
retVars = (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (RetOutStack b ++ inp))
 -> IndigoState inp (RetOutStack b ++ inp))
-> (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{DecomposedObjects
StackVars inp
GenCodeHooks
mdHooks :: forall (inp :: [*]). MetaData inp -> GenCodeHooks
mdObjects :: forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdStack :: forall (inp :: [*]). MetaData inp -> StackVars inp
mdHooks :: GenCodeHooks
mdObjects :: DecomposedObjects
mdStack :: StackVars inp
..} ->
  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 b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode inp out
gc1 ->
    SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode inp out
gc2 ->
      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 a ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars Text
"if" Expr Bool
e) ((inp :-> (RetOutStack b ++ inp))
 -> inp :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ 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 b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
        (inp :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> (Bool : inp) :-> (RetOutStack b ++ inp)
forall (s :: [*]) (s' :: [*]).
(s :-> s') -> (s :-> s') -> (Bool : s) :-> s'
L.if_ (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) (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)

-- | If-statement that works like case for Maybe.
ifSome
  :: forall inp x a b . (IfConstraint a b, KnownValue x)
  => Expr (Maybe x)
  -- ^ Expression for the control flow
  -> Var x
  -- ^ Variable for the 'Just' value (available to the next code block)
  -> SomeIndigoState (x : inp)
  -- ^ Code block for the 'Just' branch
  -> a
  -- ^ Return value(s) of the 'Just' branch
  -> SomeIndigoState inp
  -- ^ Code block for the 'Nothing' branch
  -> b
  -- ^ Return value(s) of the 'Nothing' branch
  -> RetVars a
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack a ++ inp)
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)
e Var x
varX SomeIndigoState (x : inp)
t a
retA SomeIndigoState inp
f b
retB RetVars a
retVars = (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (RetOutStack b ++ inp))
 -> IndigoState inp (RetOutStack b ++ inp))
-> (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{DecomposedObjects
StackVars inp
GenCodeHooks
mdHooks :: GenCodeHooks
mdObjects :: DecomposedObjects
mdStack :: StackVars inp
mdHooks :: forall (inp :: [*]). MetaData inp -> GenCodeHooks
mdObjects :: forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdStack :: forall (inp :: [*]). MetaData inp -> StackVars inp
..} ->
  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 b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode (x : inp) out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode (x : inp) out
gc1 ->
    SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode inp out
gc2 ->
      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 a ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars Text
"ifSome" Expr (Maybe x)
e) ((inp :-> (RetOutStack b ++ inp))
 -> inp :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ 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 b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
        ((x : inp) :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> (Maybe x : inp) :-> (RetOutStack b ++ inp)
forall a (s :: [*]) (s' :: [*]).
((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s'
L.ifSome
          ( 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 b ++ (x : inp)))
-> ((RetOutStack b ++ (x : inp)) :-> (RetOutStack b ++ inp))
-> (x : inp) :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
            -- after this we have stack (e1 & e2 .. & ek & x & 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
            -- this can be lifted together with 'gcClear' code, but let's leave it like this for now
          )
          (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)

-- | If which works like case for Either.
ifRight
  :: forall inp r l a b . (IfConstraint a b, KnownValue r, KnownValue l)
  => Expr (Either l r)
  -- ^ Expression for the control flow
  -> Var r
  -- ^ Variable for the 'Right' value (available to the next code block)
  -> SomeIndigoState (r : inp)
  -- ^ Code block for the 'Right' branch
  -> a
  -- ^ Return value(s) of the 'Right' branch
  -> Var l
  -- ^ Variable for the 'Left' value (available to the next code block)
  -> SomeIndigoState (l : inp)
  -- ^ Code block for the 'Left' branch
  -> b
  -- ^ Return value(s) of the 'Left' branch
  -> RetVars a
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack a ++ inp)
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)
e Var r
varR SomeIndigoState (r : inp)
r a
retA Var l
varL SomeIndigoState (l : inp)
l b
retB RetVars a
retVars = (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (RetOutStack b ++ inp))
 -> IndigoState inp (RetOutStack b ++ inp))
-> (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{DecomposedObjects
StackVars inp
GenCodeHooks
mdHooks :: GenCodeHooks
mdObjects :: DecomposedObjects
mdStack :: StackVars inp
mdHooks :: forall (inp :: [*]). MetaData inp -> GenCodeHooks
mdObjects :: forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdStack :: forall (inp :: [*]). MetaData inp -> StackVars inp
..} ->
  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 b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode (r : inp) out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode (r : inp) out
gc1 ->
      SomeIndigoState (l : inp)
-> MetaData (l : inp)
-> (forall (out :: [*]).
    GenCode (l : inp) out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode (l : inp) out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode (l : inp) out
gc2 ->
        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 a ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars Text
"ifRight" Expr (Either l r)
e) ((inp :-> (RetOutStack b ++ inp))
 -> inp :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ 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 b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
          ((r : inp) :-> (RetOutStack b ++ inp))
-> ((l : inp) :-> (RetOutStack b ++ inp))
-> (Either l r : inp) :-> (RetOutStack b ++ inp)
forall b (s :: [*]) (s' :: [*]) a.
((b : s) :-> s') -> ((a : s) :-> s') -> (Either a b : s) :-> s'
L.ifRight
            ( 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 b ++ (r : inp)))
-> ((RetOutStack b ++ (r : inp)) :-> (RetOutStack b ++ inp))
-> (r : inp) :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
            -- after this we have stack (e1 & e2 .. & ek & x & 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
            -- this can be lifted together with glClear code, but let's leave it like this for now
            )
            ( 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 b ++ (l : inp)))
-> ((RetOutStack b ++ (l : inp)) :-> (RetOutStack b ++ inp))
-> (l : inp) :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
            -- after this we have stack (e1 & e2 .. & ek & x & 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
            -- this can be lifted together with glClear code, but let's leave it like this for now
            )

-- | If which works like uncons for lists.
ifCons
  :: forall inp x a b . (IfConstraint a b, KnownValue x)
  => Expr (List x)
  -- ^ Expression for the control flow
  -> Var x
  -- ^ Variable for the "head" value (available to the next code block)
  -> Var (List x)
  -- ^ Variable for the "tail" value (available to the next code block)
  -> SomeIndigoState (x : List x : inp)
  -- ^ Code block for the non-empty list branch
  -> a
  -- ^ Return value(s) of the non-empty list branch
  -> SomeIndigoState inp
  -- ^ Code block for the empty list branch
  -> b
  -- ^ Return value(s) of the empty list branch
  -> RetVars a
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack a ++ inp)
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)
e Var x
vx Var (List x)
vlx SomeIndigoState (x : List x : inp)
t a
retA SomeIndigoState inp
f b
retB RetVars a
retVars = (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (RetOutStack b ++ inp))
 -> IndigoState inp (RetOutStack b ++ inp))
-> (MetaData inp -> GenCode inp (RetOutStack b ++ inp))
-> IndigoState inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{DecomposedObjects
StackVars inp
GenCodeHooks
mdHooks :: GenCodeHooks
mdObjects :: DecomposedObjects
mdStack :: StackVars inp
mdHooks :: forall (inp :: [*]). MetaData inp -> GenCodeHooks
mdObjects :: forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdStack :: forall (inp :: [*]). MetaData inp -> StackVars inp
..} ->
  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 b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode (x : List x : inp) out
    -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode (x : List x : inp) out
gc1 ->
      SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack 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 b ++ inp))
 -> GenCode inp (RetOutStack b ++ inp))
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack b ++ inp))
-> GenCode inp (RetOutStack b ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode inp out
gc2 ->
        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 a ++ inp))
-> (inp :-> (RetOutStack a ++ inp))
-> GenCode inp (RetOutStack a ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @a RetVars a
retVars Text
"ifCons" Expr (List x)
e) ((inp :-> (RetOutStack b ++ inp))
 -> inp :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> inp :-> (RetOutStack b ++ 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 b ++ inp))
-> inp :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
          ((x : List x : inp) :-> (RetOutStack b ++ inp))
-> (inp :-> (RetOutStack b ++ inp))
-> (List x : inp) :-> (RetOutStack b ++ inp)
forall a (s :: [*]) (s' :: [*]).
((a : List a : s) :-> s') -> (s :-> s') -> (List a : s) :-> s'
L.ifCons
            ( 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 b ++ (x : List x : inp)))
-> ((RetOutStack b ++ (x : List x : inp))
    :-> (RetOutStack b ++ inp))
-> (x : List x : inp) :-> (RetOutStack b ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
              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))
            (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)