-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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

-- | Backend conditional statements of Indigo

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
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)
  -- 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_ :: 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
$
        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_ (DecomposedObjects
-> GenCode inp out -> a -> inp :-> (RetOutStack a ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a DecomposedObjects
mdObjects GenCode inp out
gc1 a
retA) (DecomposedObjects
-> GenCode inp out
-> b
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b DecomposedObjects
mdObjects GenCode inp out
gc2 b
retB)

-- | If which 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 :: 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
$
        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
          ( DecomposedObjects
-> GenCode (x & inp) out
-> a
-> (x & inp) :-> (RetOutStack a ++ (x & inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a DecomposedObjects
mdObjects 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
#
            -- after this we have stack (e1 & e2 .. & ek & x & inp)
            ((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
            -- this can be lifted together with glClear code, but let's leave it like this for now
          )
          (DecomposedObjects
-> GenCode inp out
-> b
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b DecomposedObjects
mdObjects 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 :: 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
$
          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
            ( DecomposedObjects
-> GenCode (r & inp) out
-> a
-> (r & inp) :-> (RetOutStack a ++ (r & inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a DecomposedObjects
mdObjects 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
#
            -- after this we have stack (e1 & e2 .. & ek & x & inp)
            ((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
            -- this can be lifted together with glClear code, but let's leave it like this for now
            )
            ( DecomposedObjects
-> GenCode (l & inp) out
-> b
-> (l & inp)
   :-> (RetOutStack' (ClassifyReturnValue b) b ++ (l & inp))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b DecomposedObjects
mdObjects 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
#
            -- after this we have stack (e1 & e2 .. & ek & x & inp)
            ((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
            -- 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 :: 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
$
          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
            ( DecomposedObjects
-> GenCode (x & (List x & inp)) out
-> a
-> (x & (List x & inp)) :-> (RetOutStack a ++ (x & (List x & inp)))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @a DecomposedObjects
mdObjects 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)
            )
            (DecomposedObjects
-> GenCode inp out
-> b
-> inp :-> (RetOutStack' (ClassifyReturnValue b) b ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @b DecomposedObjects
mdObjects GenCode inp out
gc2 b
retB)