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

{-# LANGUAGE NoMonomorphismRestriction #-}

-- | This module implements the ability to put
-- Indigo computations on the stack as a lambda and execute them.
module Indigo.Backend.Lambda
  ( LambdaKind (..)
  , withLambdaKind
  , executeLambda1
  , initLambdaStackVars

  -- * Functionality for Frontend
  , CreateLambdaPure1C
  , ExecuteLambdaPure1C
  , CreateLambda1C
  , ExecuteLambda1C
  , CreateLambdaEff1C
  , ExecuteLambdaEff1C

  -- * Functionality for Sequential
  , CreateLambda1CGeneric
  , createLambda1Generic
  , Lambda1Generic
  ) where

import Data.Constraint ((\\))
import Fmt (fmt, pretty, (+|), (|+))

import Indigo.Backend.Expr.Compilation (compileExpr)
import Indigo.Backend.Lookup (varActionGet, varActionSet)
import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Backend.Var
import Indigo.Common.Expr (Expr(V))
import Indigo.Common.Object (IsObject)
import Indigo.Common.SIS (SomeIndigoState, runSIS)
import Indigo.Common.State
import Indigo.Common.Var
import Indigo.Lorentz
import Lorentz.Instr qualified as L
import Lorentz.Zip (ZipInstr, ZippedStack)
import Morley.Michelson.Typed.Instr.Internal.Proofs (assocThm)
import Morley.Util.Type (KnownList, type (++))

----------------------------------------------------------------------------
-- External interface
----------------------------------------------------------------------------

-- | Describes kind of lambda: pure, modifying storage, effectfull
data LambdaKind st arg res extra where
  PureLambda ::
    (ExecuteLambdaPure1C arg res, CreateLambda1CGeneric '[] arg res, Typeable res)
    => LambdaKind st arg res '[]
  StorageLambda ::
    (ExecuteLambda1C st arg res, CreateLambda1CGeneric '[st] arg res, Typeable res)
    => Proxy st
    -> LambdaKind st arg res '[st]
  EffLambda
    :: (ExecuteLambdaEff1C st arg res, CreateLambda1CGeneric '[st, Ops] arg res, Typeable res)
    => Proxy st
    -> LambdaKind st arg res '[st, Ops]

-- | Provide common constraints that are presented in all constructors of 'LambdaKind'
withLambdaKind
  :: LambdaKind st arg res extra
  -> ((ScopeCodeGen res, KnownValue arg, Typeable res, CreateLambda1CGeneric extra arg res) => r)
  -> r
withLambdaKind :: forall st arg res (extra :: [*]) r.
LambdaKind st arg res extra
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
     CreateLambda1CGeneric extra arg res) =>
    r)
-> r
withLambdaKind LambdaKind st arg res extra
PureLambda (ScopeCodeGen res, KnownValue arg, Typeable res,
 CreateLambda1CGeneric extra arg res) =>
r
r = r
(ScopeCodeGen res, KnownValue arg, Typeable res,
 CreateLambda1CGeneric extra arg res) =>
r
r
withLambdaKind (StorageLambda Proxy st
_) (ScopeCodeGen res, KnownValue arg, Typeable res,
 CreateLambda1CGeneric extra arg res) =>
r
r = r
(ScopeCodeGen res, KnownValue arg, Typeable res,
 CreateLambda1CGeneric extra arg res) =>
r
r
withLambdaKind (EffLambda Proxy st
_) (ScopeCodeGen res, KnownValue arg, Typeable res,
 CreateLambda1CGeneric extra arg res) =>
r
r = r
(ScopeCodeGen res, KnownValue arg, Typeable res,
 CreateLambda1CGeneric extra arg res) =>
r
r

-- | Execute lambda depending on its 'LambdaKind'
executeLambda1
  :: forall res st arg extra inp .
     LambdaKind st arg res extra
  -- ^ Kind of lambda
  -> RefId
  -- ^ Next free variable reference
  -> RetVars res
  -- ^ Variable that will be assigned to the resulting value
  -> LambdaExecutor extra arg res inp
executeLambda1 :: forall res st arg (extra :: [*]) (inp :: [*]).
LambdaKind st arg res extra
-> RefId -> RetVars res -> LambdaExecutor extra arg res inp
executeLambda1 LambdaKind st arg res extra
lambdaKind RefId
refId RetVars res
retVars Var (Lambda1Generic extra arg res)
lambdaVar Expr arg
argEx = LambdaKind st arg res extra
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
     CreateLambda1CGeneric extra arg res) =>
    IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall st arg res (extra :: [*]) r.
LambdaKind st arg res extra
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
     CreateLambda1CGeneric extra arg res) =>
    r)
-> r
withLambdaKind LambdaKind st arg res extra
lambdaKind (((ScopeCodeGen res, KnownValue arg, Typeable res,
   CreateLambda1CGeneric extra arg res) =>
  IndigoState
    inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
     CreateLambda1CGeneric extra arg res) =>
    IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall a b. (a -> b) -> a -> b
$
  let execStmt :: Text
execStmt = Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
"executeLambda (lambdaVar = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Var (Lambda1Generic extra arg res)
lambdaVar Var (Lambda1Generic extra arg res) -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", arg = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expr arg
argEx Expr arg -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")" in
  Text
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (forall ret. ReturnableValue ret => RetVars ret -> Text -> Text
prettyAssign @res RetVars res
retVars Text
execStmt) (IndigoState
   inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall a b. (a -> b) -> a -> b
$
    case LambdaKind st arg res extra
lambdaKind of
      LambdaKind st arg res extra
PureLambda      -> forall res arg (inp :: [*]).
ExecuteLambdaPure1C arg res =>
RetVars res -> LambdaExecutor '[] arg res inp
executeLambdaPure1 @res       RetVars res
retVars Var (Lambda1Generic extra arg res)
Var
  (WrappedLambda
     '[arg] (RetOutStack' (ClassifyReturnValue res) res ++ '[]))
lambdaVar Expr arg
argEx
      StorageLambda Proxy st
_ -> forall res st arg (inp :: [*]).
ExecuteLambda1C st arg res =>
RefId -> RetVars res -> LambdaExecutor '[st] arg res inp
executeLambdaSt1   @res RefId
refId RetVars res
retVars Var (Lambda1Generic extra arg res)
Var
  (WrappedLambda
     '[arg, st] (RetOutStack' (ClassifyReturnValue res) res ++ '[st]))
lambdaVar Expr arg
argEx
      EffLambda Proxy st
_     -> forall res st arg (inp :: [*]).
ExecuteLambdaEff1C st arg res =>
RefId -> RetVars res -> LambdaExecutor '[st, Ops] arg res inp
executeLambdaEff1  @res RefId
refId RetVars res
retVars Var (Lambda1Generic extra arg res)
Var
  (WrappedLambda
     '[arg, st, Ops]
     (RetOutStack' (ClassifyReturnValue res) res ++ '[st, Ops]))
lambdaVar Expr arg
argEx

-- | Create initial stack vars depending on 'LambdaKind'
initLambdaStackVars :: LambdaKind st arg res extra -> Var arg -> StackVars (arg : extra)
initLambdaStackVars :: forall st arg res (extra :: [*]).
LambdaKind st arg res extra -> Var arg -> StackVars (arg : extra)
initLambdaStackVars LambdaKind st arg res extra
PureLambda = Var arg -> StackVars (arg : extra)
forall arg. KnownValue arg => Var arg -> StackVars '[arg]
initStackVarsPure
initLambdaStackVars (StorageLambda Proxy st
_) = Var arg -> StackVars (arg : extra)
forall st arg.
(HasStorage st, KnownValue arg) =>
Var arg -> StackVars '[arg, st]
initStackVars
initLambdaStackVars (EffLambda Proxy st
_) = Var arg -> StackVars (arg : extra)
forall st arg.
(HasSideEffects, HasStorage st, KnownValue arg) =>
Var arg -> StackVars '[arg, st, Ops]
initStackVarsEff

type Lambda1Generic extra arg res = WrappedLambda (arg : extra) (RetOutStack res ++ extra)

type CreateLambda1CGeneric extra arg res =
  ( ScopeCodeGen res, KnownValue arg, Typeable extra, KnownList extra
  , ZipInstr (arg : extra)
  , KnownValue (ZippedStack (arg ': extra))
  , KnownValue (ZippedStack (RetOutStack res ++ extra))
  , ZipInstr (RetOutStack res ++ extra)
  , Typeable (RetOutStack res ++ extra)
  )

-- | Create a lambda, that takes only one argument, from the given computation,
-- and return a variable referring to this lambda.
createLambda1Generic
  :: forall arg res extra inp . CreateLambda1CGeneric extra arg res
  => Var (Lambda1Generic extra arg res)
  -> res
  -> StackVars (arg : extra)
  -> SomeIndigoState (arg : extra)
  -> IndigoState inp (Lambda1Generic extra arg res : inp)
createLambda1Generic :: forall arg res (extra :: [*]) (inp :: [*]).
CreateLambda1CGeneric extra arg res =>
Var (Lambda1Generic extra arg res)
-> res
-> StackVars (arg : extra)
-> SomeIndigoState (arg : extra)
-> IndigoState inp (Lambda1Generic extra arg res : inp)
createLambda1Generic Var (Lambda1Generic extra arg res)
var res
ret StackVars (arg : extra)
initMd SomeIndigoState (arg : extra)
act = (MetaData inp -> GenCode inp (Lambda1Generic extra arg res : inp))
-> IndigoState inp (Lambda1Generic extra arg res : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (Lambda1Generic extra arg res : inp))
 -> IndigoState inp (Lambda1Generic extra arg res : inp))
-> (MetaData inp
    -> GenCode inp (Lambda1Generic extra arg res : inp))
-> IndigoState inp (Lambda1Generic extra arg res : 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
..} ->
  -- Decomposed objects are passed as mempty here because in the lambda
  -- we don't decompose storage value (but we might be doing it as an optimisation)
  -- so we just have it as an stack cell
  SomeIndigoState (arg : extra)
-> MetaData (arg : extra)
-> (forall (out :: [*]).
    GenCode (arg : extra) out
    -> GenCode inp (Lambda1Generic extra arg res : inp))
-> GenCode inp (Lambda1Generic extra arg res : inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (arg : extra)
act (StackVars (arg : extra)
-> DecomposedObjects -> GenCodeHooks -> MetaData (arg : extra)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars (arg : extra)
initMd DecomposedObjects
forall a. Monoid a => a
mempty GenCodeHooks
mdHooks) ((forall (out :: [*]).
  GenCode (arg : extra) out
  -> GenCode inp (Lambda1Generic extra arg res : inp))
 -> GenCode inp (Lambda1Generic extra arg res : inp))
-> (forall (out :: [*]).
    GenCode (arg : extra) out
    -> GenCode inp (Lambda1Generic extra arg res : inp))
-> GenCode inp (Lambda1Generic extra arg res : inp)
forall a b. (a -> b) -> a -> b
$ \GenCode (arg : extra) out
lambdaBody ->
    let gcStack :: StackVars (Lambda1Generic extra arg res : inp)
gcStack = Var (Lambda1Generic extra arg res)
-> StackVars inp -> StackVars (Lambda1Generic extra arg res : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var (Lambda1Generic extra arg res)
var StackVars inp
mdStack
        gcCode :: inp :-> (Lambda1Generic extra arg res : inp)
gcCode =
          MetaData inp
-> Text
-> (inp :-> (Lambda1Generic extra arg res : inp))
-> inp :-> (Lambda1Generic extra arg res : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret. ReturnableValue ret => RetVars ret -> Text -> Text
prettyAssign @(Var (Lambda1Generic extra arg res)) Var (Lambda1Generic extra arg res)
RetVars (Var (Lambda1Generic extra arg res))
var Text
"createLambda") ((inp :-> (Lambda1Generic extra arg res : inp))
 -> inp :-> (Lambda1Generic extra arg res : inp))
-> (inp :-> (Lambda1Generic extra arg res : inp))
-> inp :-> (Lambda1Generic extra arg res : inp)
forall a b. (a -> b) -> a -> b
$
            (IsNotInView => (arg : extra) :-> (RetOutStack res ++ extra))
-> inp :-> (Lambda1Generic extra arg res : inp)
forall (i :: [*]) (o :: [*]) (s :: [*]).
ZipInstrs '[i, o] =>
(IsNotInView => i :-> o) -> s :-> (WrappedLambda i o : s)
L.lambda ((StackVars out -> MetaData out)
-> GenCode (arg : extra) out
-> res
-> (arg : extra) :-> (RetOutStack res ++ (arg : extra))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode (arg : extra) out
lambdaBody res
ret ((arg : extra) :-> (RetOutStack res ++ (arg : extra)))
-> ((RetOutStack res ++ (arg : extra))
    :-> (RetOutStack res ++ extra))
-> (arg : extra) :-> (RetOutStack res ++ extra)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
                      forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
liftClear @res @extra @(arg : extra) (arg : extra) :-> extra
forall a (s :: [*]). (a : s) :-> s
L.drop)
        gcClear :: (a : s) :-> s
gcClear = (a : s) :-> s
forall a (s :: [*]). (a : s) :-> s
L.drop
    in GenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {inp :-> (Lambda1Generic extra arg res : inp)
(Lambda1Generic extra arg res : inp) :-> inp
StackVars (Lambda1Generic extra arg res : inp)
forall a (s :: [*]). (a : s) :-> s
gcClear :: (Lambda1Generic extra arg res : inp) :-> inp
gcCode :: inp :-> (Lambda1Generic extra arg res : inp)
gcStack :: StackVars (Lambda1Generic extra arg res : inp)
gcClear :: forall a (s :: [*]). (a : s) :-> s
gcCode :: inp :-> (Lambda1Generic extra arg res : inp)
gcStack :: StackVars (Lambda1Generic extra arg res : inp)
..}

----------------------------------------------------------------------------
-- Pure lambdas
----------------------------------------------------------------------------

type CreateLambdaPure1C arg res = CreateLambda1CGeneric '[] arg res

type ExecuteLambdaPure1C arg res = ExecuteLambda1CGeneric '[] arg res

-- | Execute a lambda, which accepts only one argument, on passed expression.
executeLambdaPure1
  :: forall res arg inp. ExecuteLambdaPure1C arg res
  => RetVars res
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> LambdaExecutor '[] arg res inp
executeLambdaPure1 :: forall res arg (inp :: [*]).
ExecuteLambdaPure1C arg res =>
RetVars res -> LambdaExecutor '[] arg res inp
executeLambdaPure1 RetVars res
retVars = forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic @res RetVars res
retVars IndigoState inp ('[] ++ inp)
forall (inp :: [*]). IndigoState inp inp
nopState

initStackVarsPure :: KnownValue arg => Var arg -> StackVars '[arg]
initStackVarsPure :: forall arg. KnownValue arg => Var arg -> StackVars '[arg]
initStackVarsPure Var arg
var = Var arg -> StackVars '[] -> StackVars '[arg]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var arg
var StackVars '[]
emptyStack

----------------------------------------------------------------------------
-- Impure lambda (modifying storage only)
----------------------------------------------------------------------------

type CreateLambda1C st arg res = (KnownValue st, CreateLambda1CGeneric '[st] arg res)

type ExecuteLambda1C st arg res =
  ( IsObject st
  , HasStorage st
  , ExecuteLambda1CGeneric '[st] arg res
  )

-- | Execute a lambda that accepts only one argument on the given expression.
executeLambdaSt1
  :: forall res st arg inp. ExecuteLambda1C st arg res
  => RefId
  -> RetVars res
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> LambdaExecutor '[st] arg res inp
executeLambdaSt1 :: forall res st arg (inp :: [*]).
ExecuteLambda1C st arg res =>
RefId -> RetVars res -> LambdaExecutor '[st] arg res inp
executeLambdaSt1 RefId
nextRef RetVars res
retVars = forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic @res RetVars res
retVars (IndigoState inp ('[st] ++ inp)
 -> Var (Lambda1Generic '[st] arg res)
 -> Expr arg
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState inp ('[st] ++ inp)
-> Var (Lambda1Generic '[st] arg res)
-> Expr arg
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall a b. (a -> b) -> a -> b
$
    (MetaData inp -> GenCode inp (st : inp))
-> IndigoState inp (st : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (st : inp))
 -> IndigoState inp (st : inp))
-> (MetaData inp -> GenCode inp (st : inp))
-> IndigoState inp (st : inp)
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
      let storage :: Var st
storage = forall st. HasStorage st => Var st
storageVar @st
          -- TODO this @compileExpr (V (storageVar @st))@ call materialises the whole decomposed storage.
          -- This is pretty expensive operation and it has to be fixed:
          -- we have to materialise only fields used in the lambda
          GenCode StackVars (st : inp)
resStack inp :-> (st : inp)
fetchStorage (st : inp) :-> inp
_ =
            MetaData inp
-> IndigoState inp (st : inp) -> GenCode inp (st : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp (st : inp) -> GenCode inp (st : inp))
-> IndigoState inp (st : inp) -> GenCode inp (st : inp)
forall a b. (a -> b) -> a -> b
$ Text -> IndigoState inp (st : inp) -> IndigoState inp (st : inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
exprHookState Text
"Computing storage" (IndigoState inp (st : inp) -> IndigoState inp (st : inp))
-> IndigoState inp (st : inp) -> IndigoState inp (st : inp)
forall a b. (a -> b) -> a -> b
$ Expr st -> IndigoState inp (st : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
storage)
          tmpVar :: Var st
tmpVar = RefId -> Var st
forall {k} (a :: k). RefId -> Var a
Var RefId
nextRef
          setStorage :: (st : inp) :-> inp
setStorage =
            MetaData inp -> Text -> ((st : inp) :-> inp) -> (st : inp) :-> inp
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md Text
"Update storage with returned from lambda" (((st : inp) :-> inp) -> (st : inp) :-> inp)
-> ((st : inp) :-> inp) -> (st : inp) :-> inp
forall a b. (a -> b) -> a -> b
$
              GenCode (st : inp) (st : inp) -> (st : inp) :-> (st : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (MetaData (st : inp)
-> IndigoState (st : inp) (st : inp)
-> GenCode (st : inp) (st : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (Var st -> MetaData inp -> MetaData (st : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var st
tmpVar MetaData inp
md) (IndigoState (st : inp) (st : inp)
 -> GenCode (st : inp) (st : inp))
-> IndigoState (st : inp) (st : inp)
-> GenCode (st : inp) (st : inp)
forall a b. (a -> b) -> a -> b
$
                      RefId -> Var st -> Expr st -> IndigoState (st : inp) (st : inp)
forall a (inp :: [*]).
KnownValue a =>
RefId -> Var a -> Expr a -> IndigoState inp inp
setVar (RefId
nextRef RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ RefId
1) Var st
storage (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
tmpVar))
              # L.drop
      in StackVars (st : inp)
-> (inp :-> (st : inp))
-> ((st : inp) :-> inp)
-> GenCode inp (st : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars (st : inp)
resStack inp :-> (st : inp)
fetchStorage (st : inp) :-> inp
setStorage


initStackVars :: (HasStorage st, KnownValue arg) => Var arg -> StackVars '[arg, st]
initStackVars :: forall st arg.
(HasStorage st, KnownValue arg) =>
Var arg -> StackVars '[arg, st]
initStackVars Var arg
var = StackVars '[]
emptyStack
  StackVars '[]
-> (StackVars '[] -> StackVars '[st]) -> StackVars '[st]
forall a b. a -> (a -> b) -> b
& Var st -> StackVars '[] -> StackVars '[st]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var st
forall st. HasStorage st => Var st
storageVar
  StackVars '[st]
-> (StackVars '[st] -> StackVars '[arg, st])
-> StackVars '[arg, st]
forall a b. a -> (a -> b) -> b
& Var arg -> StackVars '[st] -> StackVars '[arg, st]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var arg
var
  -- This 'storageVar' usage is intentional.
  -- We have to provide 'HasStorage' for a lambda.
  -- To avoid excessive 'given' calls with new indexes,

----------------------------------------------------------------------------
-- Lambda with side effects (might emit operations)
----------------------------------------------------------------------------

type CreateLambdaEff1C st arg res = (KnownValue st, CreateLambda1CGeneric '[st, Ops] arg res)

type ExecuteLambdaEff1C st arg res =
  ( HasStorage st
  , HasSideEffects
  , IsObject st
  , ExecuteLambda1CGeneric '[st, Ops] arg res
  )

-- | Execute a lambda that accepts only one argument on the given expression.
-- Also updates the storage and operations with the values returned from the lambda.
executeLambdaEff1
  :: forall res st arg inp. ExecuteLambdaEff1C st arg res
  => RefId
  -> RetVars res
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> LambdaExecutor '[st, Ops] arg res inp
executeLambdaEff1 :: forall res st arg (inp :: [*]).
ExecuteLambdaEff1C st arg res =>
RefId -> RetVars res -> LambdaExecutor '[st, Ops] arg res inp
executeLambdaEff1 RefId
nextRef RetVars res
retVars =
  forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic @res RetVars res
retVars (IndigoState inp ('[st, Ops] ++ inp)
 -> Var (Lambda1Generic '[st, Ops] arg res)
 -> Expr arg
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState inp ('[st, Ops] ++ inp)
-> Var (Lambda1Generic '[st, Ops] arg res)
-> Expr arg
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall a b. (a -> b) -> a -> b
$
    -- TODO this @compileExpr (V (storageVar @st))@ call materialises the whole decomposed storage.
    -- This is pretty expensive operation and it has to be fixed:
    -- we have to materialise only fields used in the lambda
    (MetaData inp -> GenCode inp (st : Ops : inp))
-> IndigoState inp (st : Ops : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (st : Ops : inp))
 -> IndigoState inp (st : Ops : inp))
-> (MetaData inp -> GenCode inp (st : Ops : inp))
-> IndigoState inp (st : Ops : 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 storage :: Var st
storage = forall st. HasStorage st => Var st
storageVar @st
          ops :: Var Ops
ops = Var Ops
HasSideEffects => Var Ops
operationsVar
          opsRefId :: RefId
opsRefId = case Var Ops
ops of Var RefId
x -> RefId
x
          gcStack :: StackVars (st : Ops : inp)
gcStack = Var st -> StackVars (Ops : inp) -> StackVars (st : Ops : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var st
storage (StackVars (Ops : inp) -> StackVars (st : Ops : inp))
-> StackVars (Ops : inp) -> StackVars (st : Ops : inp)
forall a b. (a -> b) -> a -> b
$ Var Ops -> StackVars inp -> StackVars (Ops : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var Ops
ops StackVars inp
mdStack
          fetchCode :: inp :-> (st : Ops : inp)
fetchCode =
            MetaData inp
-> Text -> (inp :-> (Ops : inp)) -> inp :-> (Ops : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md Text
"Fetching operations" (RefId -> StackVars inp -> inp :-> (Ops : inp)
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> stk :-> (a : stk)
varActionGet RefId
opsRefId StackVars inp
mdStack) (inp :-> (Ops : inp))
-> ((Ops : inp) :-> (st : Ops : inp)) -> inp :-> (st : Ops : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
            (MetaData inp
-> Text
-> ((Ops : inp) :-> (st : Ops : inp))
-> (Ops : inp) :-> (st : Ops : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md Text
"Computing storage" (((Ops : inp) :-> (st : Ops : inp))
 -> (Ops : inp) :-> (st : Ops : inp))
-> ((Ops : inp) :-> (st : Ops : inp))
-> (Ops : inp) :-> (st : Ops : inp)
forall a b. (a -> b) -> a -> b
$
              GenCode (Ops : inp) (st : Ops : inp)
-> (Ops : inp) :-> (st : Ops : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode (Ops : inp) (st : Ops : inp)
 -> (Ops : inp) :-> (st : Ops : inp))
-> GenCode (Ops : inp) (st : Ops : inp)
-> (Ops : inp) :-> (st : Ops : inp)
forall a b. (a -> b) -> a -> b
$ MetaData (Ops : inp)
-> IndigoState (Ops : inp) (st : Ops : inp)
-> GenCode (Ops : inp) (st : Ops : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (MetaData inp -> StackVars (Ops : inp) -> MetaData (Ops : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (Ops : inp)
sPlus) (IndigoState (Ops : inp) (st : Ops : inp)
 -> GenCode (Ops : inp) (st : Ops : inp))
-> IndigoState (Ops : inp) (st : Ops : inp)
-> GenCode (Ops : inp) (st : Ops : inp)
forall a b. (a -> b) -> a -> b
$ Expr st -> IndigoState (Ops : inp) (st : Ops : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
storage))
          sPlus :: StackVars (Ops : inp)
sPlus = StackVars inp -> StackVars (Ops : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef StackVars inp
mdStack
          tmpVar :: Var st
tmpVar = RefId -> Var st
forall {k} (a :: k). RefId -> Var a
Var RefId
nextRef
          setStorage :: (st : Ops : inp) :-> (Ops : inp)
setStorage =
            MetaData inp
-> Text
-> ((st : Ops : inp) :-> (Ops : inp))
-> (st : Ops : inp) :-> (Ops : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md Text
"Update storage with returned from lambda" (((st : Ops : inp) :-> (Ops : inp))
 -> (st : Ops : inp) :-> (Ops : inp))
-> ((st : Ops : inp) :-> (Ops : inp))
-> (st : Ops : inp) :-> (Ops : inp)
forall a b. (a -> b) -> a -> b
$
              GenCode (st : Ops : inp) (st : Ops : inp)
-> (st : Ops : inp) :-> (st : Ops : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (MetaData (st : Ops : inp)
-> IndigoState (st : Ops : inp) (st : Ops : inp)
-> GenCode (st : Ops : inp) (st : Ops : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (MetaData inp
-> StackVars (st : Ops : inp) -> MetaData (st : Ops : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md (Var st -> StackVars (Ops : inp) -> StackVars (st : Ops : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var st
tmpVar StackVars (Ops : inp)
sPlus)) (IndigoState (st : Ops : inp) (st : Ops : inp)
 -> GenCode (st : Ops : inp) (st : Ops : inp))
-> IndigoState (st : Ops : inp) (st : Ops : inp)
-> GenCode (st : Ops : inp) (st : Ops : inp)
forall a b. (a -> b) -> a -> b
$ RefId
-> Var st
-> Expr st
-> IndigoState (st : Ops : inp) (st : Ops : inp)
forall a (inp :: [*]).
KnownValue a =>
RefId -> Var a -> Expr a -> IndigoState inp inp
setVar (RefId
nextRef RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ RefId
1) Var st
storage (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
tmpVar))
              # L.drop
          gcClear :: (st : Ops : inp) :-> inp
gcClear = (st : Ops : inp) :-> (Ops : inp)
setStorage ((st : Ops : inp) :-> (Ops : inp))
-> ((Ops : inp) :-> inp) -> (st : Ops : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
                    MetaData inp
-> Text -> ((Ops : inp) :-> inp) -> (Ops : inp) :-> inp
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md Text
"Update operations with returned from lambda" (RefId -> StackVars inp -> (Ops : inp) :-> inp
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> (a : stk) :-> stk
varActionSet RefId
opsRefId StackVars inp
mdStack)
      in GenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {gcCode :: inp :-> (st : Ops : inp)
gcCode=inp :-> (st : Ops : inp)
fetchCode,(st : Ops : inp) :-> inp
StackVars (st : Ops : inp)
gcClear :: (st : Ops : inp) :-> inp
gcStack :: StackVars (st : Ops : inp)
gcClear :: (st : Ops : inp) :-> inp
gcStack :: StackVars (st : Ops : inp)
..}

initStackVarsEff
  :: (HasSideEffects, HasStorage st, KnownValue arg)
  => Var arg -> StackVars '[arg, st, Ops]
initStackVarsEff :: forall st arg.
(HasSideEffects, HasStorage st, KnownValue arg) =>
Var arg -> StackVars '[arg, st, Ops]
initStackVarsEff Var arg
var = StackVars '[]
emptyStack
  StackVars '[]
-> (StackVars '[] -> StackVars '[Ops]) -> StackVars '[Ops]
forall a b. a -> (a -> b) -> b
& Var Ops -> StackVars '[] -> StackVars '[Ops]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var Ops
HasSideEffects => Var Ops
operationsVar
  StackVars '[Ops]
-> (StackVars '[Ops] -> StackVars '[st, Ops])
-> StackVars '[st, Ops]
forall a b. a -> (a -> b) -> b
& Var st -> StackVars '[Ops] -> StackVars '[st, Ops]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var st
forall st. HasStorage st => Var st
storageVar
  StackVars '[st, Ops]
-> (StackVars '[st, Ops] -> StackVars '[arg, st, Ops])
-> StackVars '[arg, st, Ops]
forall a b. a -> (a -> b) -> b
& Var arg -> StackVars '[st, Ops] -> StackVars '[arg, st, Ops]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var arg
var

----------------------------------------------------------------------------
-- Generic functionality of lambda execution
----------------------------------------------------------------------------

type ExecuteLambda1CGeneric extra arg res =
  ( ScopeCodeGen res, KnownValue arg
  , KnownValue (WrappedLambda (arg : extra) (RetOutStack res ++ extra))
  , KnownList extra
  , ZipInstr (arg : extra)
  , KnownList (RetOutStack res ++ extra)
  , ZipInstr (RetOutStack res ++ extra)
  , Typeable (RetOutStack res ++ extra)
  , Typeable extra
  , KnownValue (ZippedStack (RetOutStack res ++ extra))
  )

type LambdaExecutor extra arg res inp
   = Var (Lambda1Generic extra arg res)
  -> Expr arg
  -> IndigoState inp (RetOutStack res ++ inp)

-- | Execute a lambda that accepts only one argument on the given expression.
-- Also updates the storage and operations with the values returned from the lambda.
executeLambda1Generic
  :: forall res arg extra inp . ExecuteLambda1CGeneric extra arg res
  => RetVars res
  -> IndigoState inp (extra ++ inp)
  -> Var (Lambda1Generic extra arg res)
  -> Expr arg
  -> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic :: forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic RetVars res
vars IndigoState inp (extra ++ inp)
allocateCleanup Var
  (WrappedLambda
     (arg : extra)
     (RetOutStack' (ClassifyReturnValue res) res ++ extra))
varF Expr arg
argm = (MetaData inp
 -> GenCode inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
  -> GenCode inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> (MetaData inp
    -> GenCode inp (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue res) res ++ 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 GenCode StackVars (extra ++ inp)
allocStk inp :-> (extra ++ inp)
allocate (extra ++ inp) :-> inp
cleanup = MetaData inp
-> IndigoState inp (extra ++ inp) -> GenCode inp (extra ++ inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md IndigoState inp (extra ++ inp)
allocateCleanup
      getArgs :: inp
:-> (WrappedLambda
       (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
       : arg : (extra ++ inp))
getArgs =
        MetaData inp
-> Text -> (inp :-> (extra ++ inp)) -> inp :-> (extra ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md Text
"Computing implicit lambda arguments" inp :-> (extra ++ inp)
allocate (inp :-> (extra ++ inp))
-> ((extra ++ inp)
    :-> (WrappedLambda
           (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
           : arg : (extra ++ inp)))
-> inp
   :-> (WrappedLambda
          (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
          : arg : (extra ++ inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
        (GenCode
  (extra ++ inp)
  (WrappedLambda
     (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
     : arg : (extra ++ inp))
-> (extra ++ inp)
   :-> (WrappedLambda
          (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
          : arg : (extra ++ inp))
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode
   (extra ++ inp)
   (WrappedLambda
      (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
      : arg : (extra ++ inp))
 -> (extra ++ inp)
    :-> (WrappedLambda
           (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
           : arg : (extra ++ inp)))
-> GenCode
     (extra ++ inp)
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
-> (extra ++ inp)
   :-> (WrappedLambda
          (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
          : arg : (extra ++ inp))
forall a b. (a -> b) -> a -> b
$
          MetaData (extra ++ inp)
-> IndigoState
     (extra ++ inp)
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
-> GenCode
     (extra ++ inp)
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (MetaData inp -> StackVars (extra ++ inp) -> MetaData (extra ++ inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (extra ++ inp)
allocStk) (IndigoState
   (extra ++ inp)
   (WrappedLambda
      (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
      : arg : (extra ++ inp))
 -> GenCode
      (extra ++ inp)
      (WrappedLambda
         (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
         : arg : (extra ++ inp)))
-> IndigoState
     (extra ++ inp)
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
-> GenCode
     (extra ++ inp)
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
forall a b. (a -> b) -> a -> b
$ do
              Text
-> IndigoState (extra ++ inp) (arg : (extra ++ inp))
-> IndigoState (extra ++ inp) (arg : (extra ++ inp))
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
exprHookState (Text
"Computing lambda parameter: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr arg -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr arg
argm) (Expr arg -> IndigoState (extra ++ inp) (arg : (extra ++ inp))
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr arg
argm)
              Text
-> IndigoState
     (arg : (extra ++ inp))
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
-> IndigoState
     (arg : (extra ++ inp))
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
exprHookState Text
"Fetching lambda" (Expr
  (WrappedLambda
     (arg : extra)
     (RetOutStack' (ClassifyReturnValue res) res ++ extra))
-> IndigoState
     (arg : (extra ++ inp))
     (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp))
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr (Var
  (WrappedLambda
     (arg : extra)
     (RetOutStack' (ClassifyReturnValue res) res ++ extra))
-> Expr
     (WrappedLambda
        (arg : extra)
        (RetOutStack' (ClassifyReturnValue res) res ++ extra))
forall a. KnownValue a => Var a -> Expr a
V Var
  (WrappedLambda
     (arg : extra)
     (RetOutStack' (ClassifyReturnValue res) res ++ extra))
varF)))
      code :: inp :-> (RetOutStack' (ClassifyReturnValue res) res ++ inp)
code = inp
:-> (WrappedLambda
       (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
       : arg : (extra ++ inp))
getArgs (inp
 :-> (WrappedLambda
        (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
        : arg : (extra ++ inp)))
-> ((WrappedLambda
       (arg : extra) (RetOutStack' (ClassifyReturnValue res) res ++ extra)
       : arg : (extra ++ inp))
    :-> (RetOutStack' (ClassifyReturnValue res) res ++ (extra ++ inp)))
-> inp
   :-> (RetOutStack' (ClassifyReturnValue res) res ++ (extra ++ inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
              forall (i :: [*]) (o :: [*]) (s :: [*]).
Each '[KnownList, ZipInstr] '[i, o] =>
(WrappedLambda i o : (i ++ s)) :-> (o ++ s)
L.execute @_ @_ @inp (inp
 :-> (RetOutStack' (ClassifyReturnValue res) res ++ (extra ++ inp)))
-> ((RetOutStack' (ClassifyReturnValue res) res ++ (extra ++ inp))
    :-> (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
              forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
liftClear @res (extra ++ inp) :-> inp
cleanup
              ((((RetOutStack' (ClassifyReturnValue res) res ++ extra) ++ inp)
  ~ (RetOutStack' (ClassifyReturnValue res) res
     ++ (extra ++ inp))) =>
 inp :-> (RetOutStack' (ClassifyReturnValue res) res ++ inp))
-> (((RetOutStack' (ClassifyReturnValue res) res ++ extra) ++ inp)
    :~: (RetOutStack' (ClassifyReturnValue res) res ++ (extra ++ inp)))
-> inp :-> (RetOutStack' (ClassifyReturnValue res) res ++ inp)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (a :: [*]) (b :: [*]) (c :: [*]).
((a ++ b) ++ c) :~: (a ++ (b ++ c))
forall {k} (a :: [k]) (b :: [k]) (c :: [k]).
((a ++ b) ++ c) :~: (a ++ (b ++ c))
assocThm @(RetOutStack res) @extra @inp
  in forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @res StackVars inp
mdStack RetVars res
vars inp :-> (RetOutStack' (ClassifyReturnValue res) res ++ inp)
code