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

-- | 'Instruction' datatype and its compilations.
--
-- The idea behind this module is to provide an intermediate representation that
-- can:
--
-- - be generated from the frontend freer monad
-- - be compiled to the backend 'IndigoState'
-- - be easy to analyze, manipulate and modify
--
-- This is meant to be the common ground for modular optimizations on the code
-- before this is handed off to the backend and eventually translated to
-- Michelson.

module Indigo.Compilation.Sequential
  ( Block
  , Instruction (..)

  , IndigoSeqCaseClause (..)
  , CaseBranch (..)

  -- * Translations
  , SequentialHooks (..)
  , stmtHookL
  , InstrCollector (..)
  , indigoMtoSequential
  , sequentialToLorentz

  -- * Case machinery
  , updateClauses
  , mapMClauses
  ) where

import Prelude

import Data.Vinyl.Core (RMap(..))

import Lens.Micro.TH (makeLensesFor)
import Lorentz.Entrypoints.Helpers (RequireSumType)
import qualified Lorentz.Run as L (Contract)
import Michelson.Typed.Haskell.Instr.Sum (CaseClauseParam(..), CtorField(..))
import Util.TypeLits (AppendSymbol)

import Indigo.Backend
import Indigo.Frontend.Program
import qualified Indigo.Frontend.Statement as S
import Indigo.Internal (Expr, HasField)
import Indigo.Internal.Object (IsObject)
import Indigo.Internal.SIS
import Indigo.Internal.State hiding ((>>))
import qualified Indigo.Internal.State as St
import Indigo.Internal.Var
import Indigo.Lorentz
import qualified Michelson.Typed as MT

-- | Simple synonym for a list of 'Instruction'
type Block = [Instruction]

-- | Data type representing an instruction.
--
-- Differently from the frontend this is not used to build a Monad of some kind,
-- it is instead based on having as argument the variable to associate with the
-- resulting value (if any).
--
-- This is combined in simple lists, named 'Block', and it is intended to be
-- easily altered, this is because these are used as the intermediate representation
-- between the frontend and the backend, where optimizations can occur.
data Instruction where
  LiftIndigoState :: (forall inp. SomeIndigoState inp) -> Instruction
  Comment :: Text -> Instruction

  AssignVar :: KnownValue x => Var x -> Expr x -> Instruction
  SetVar :: KnownValue x => Var x -> Expr x -> Instruction
  VarModification
    :: (IsObject x, KnownValue y)
    => [y, x] :-> '[x]
    -> Var x
    -> Expr y
    -> Instruction
  SetField
    :: ( HasField store fname ftype
       , IsObject store
       , IsObject ftype
       )
    => Var store -> Label fname -> Expr ftype -> Instruction

  LambdaCall1
    :: LambdaKind st arg ret extra
    -- ^ Kind of lambda (pure, storage modification, fully functional lambda with effects)
    -> String
    -- ^ Name of the lambda
    -> Expr arg
    -- ^ Expression for the lambda argument
    -> Var arg
    -- ^ Variable for the argument value (available to the lambda code block)
    -> Block
    -- ^ Code block for the lambda
    -> ret
    -- ^ Return value(s) of the lambda
    -> RetVars ret
    -- ^ Variable(s) that will be assigned to the resulting value(s)
    -> Instruction

  CreateLambda1
    :: CreateLambda1CGeneric extra arg ret
    => StackVars (arg : extra)
    -- ^ Initial 'StackVars' to be used in the lambda code
    -> Var arg
    -- ^ Variable for the argument value (available to the lambda code block)
    -> Block
    -- ^ Code block for the lambda
    -> ret
    -- ^ Return value(s) of the lambda
    -> Var (Lambda1Generic extra arg ret)
    -- ^ Variable that will be assigned to the resulting lambda
    -> Instruction

  ExecLambda1
    :: LambdaKind st arg ret extra
    -> Proxy ret
    -> Expr arg
    -- ^ Expression for the lambda argument
    -> Var (Lambda1Generic extra arg ret)
    -- ^ Variable of the lambda to be executed
    -> RetVars ret
    -- ^ Variable(s) that will be assigned to the resulting value(s)
    -> Instruction

  Scope
    :: ScopeCodeGen ret
    => Block
    -- ^ Code block to execute inside the scope
    -> ret
    -- ^ Return value(s) of the scoped code block
    -> RetVars ret
    -- ^ Variable that will be assigned to the resulting value(s)
    -> Instruction
  If
    :: IfConstraint a b
    => Expr Bool
    -- ^ Expression for the control flow
    -> Block
    -- ^ Code block for the positive branch
    -> a
    -- ^ Return value(s) of the positive branch
    -> Block
    -- ^ 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)
    -> Instruction
  IfSome
    :: (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)
    -> Block
    -- ^ Code block for the 'Just' branch
    -> a
    -- ^ Return value(s) of the 'Just' branch
    -> Block
    -- ^ 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)
    -> Instruction
  IfRight
    :: (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)
    -> Block
    -- ^ 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)
    -> Block
    -- ^ 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)
    -> Instruction
  IfCons
    :: (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)
    -> Block
    -- ^ Code block for the non-empty list branch
    -> a
    -- ^ Return value(s) of the non-empty list branch
    -> Block
    -- ^ 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)
    -> Instruction

  Case
    :: CaseCommon dt ret clauses
    => Expr dt
    -> clauses
    -> RetVars ret
    -- ^ Variable(s) that will be assigned to the resulting value(s)
    -> Instruction
  EntryCase
    :: ( CaseCommon dt ret clauses
       , DocumentEntrypoints entryPointKind dt
       )
    => Proxy entryPointKind
    -> Expr dt
    -> clauses
    -> RetVars ret
    -- ^ Variable(s) that will be assigned to the resulting value(s)
    -> Instruction
  EntryCaseSimple
    :: ( CaseCommon dt ret clauses
       , DocumentEntrypoints PlainEntrypointsKind dt
       , NiceParameterFull dt
       , RequireFlatParamEps dt
       )
    => Expr dt
    -> clauses
    -> RetVars ret
    -- ^ Variable(s) that will be assigned to the resulting value(s)
    -> Instruction

  While
    :: Expr Bool
    -- ^ Expression for the control flow
    -> Block
    -- ^ Block of code to execute, as long as the expression holds 'True'
    -> Instruction
  WhileLeft
    :: (KnownValue l, KnownValue r)
    => Expr (Either l r)
    -- ^ Expression for the control flow value
    -> Var l
    -- ^ Variable for the 'Left' value (available to the code block)
    -> Block
    -- ^ Code block to execute while the value is 'Left'
    -> Var r
    -- ^ Variable that will be assigned to the resulting value
    -> Instruction
  ForEach
    :: (IterOpHs a, KnownValue (IterOpElHs a))
    => Expr a
    -- ^ Expression for the container to traverse
    -> Var (IterOpElHs a)
    -- ^ Variable for the current item (available to the code block)
    -> Block
    -- ^ Code block to execute over each element of the container
    -> Instruction

  ContractName
    :: Text
    -> Block
    -> Instruction
  DocGroup
    :: forall di. DocItem di
    => (SubDoc -> di)
    -> Block
    -> Instruction
  ContractGeneral
    :: Block
    -> Instruction
  FinalizeParamCallingDoc
    :: (NiceParameterFull cp, RequireSumType cp)
    => Var cp
    -> Block
    -> Expr cp
    -> Instruction

  TransferTokens
    :: (NiceParameter p, HasSideEffects)
    => Expr p
    -> Expr Mutez
    -> Expr (ContractRef p)
    -> Instruction
  SetDelegate
    :: HasSideEffects
    => Expr (Maybe KeyHash)
    -> Instruction

  CreateContract
    :: (HasSideEffects, NiceStorage s, NiceParameterFull p)
    => L.Contract p s
    -> Expr (Maybe KeyHash)
    -> Expr Mutez
    -> Expr s
    -> Var Address
    -- ^ Variable that will be assigned to the resulting 'Address'
    -> Instruction
  SelfCalling
    :: ( NiceParameterFull p
       , KnownValue (GetEntrypointArgCustom p mname)
       )
    => Proxy p
    -> EntrypointRef mname
    -> Var (ContractRef (GetEntrypointArgCustom p mname))
    -- ^ Variable that will be assigned to the resulting 'ContractRef'
    -> Instruction
  ContractCalling
    :: ( HasEntrypointArg cp epRef epArg
       , ToTAddress cp addr
       , ToT addr ~ ToT Address
       , KnownValue epArg
       )
    => Proxy cp
    -> epRef
    -> Expr addr
    -> Var (Maybe (ContractRef epArg))
    -- ^ Variable that will be assigned to the resulting 'ContractRef'
    -> Instruction

  Fail
    :: (forall inp. SomeIndigoState inp)
    -> Instruction
  FailOver
    :: (forall inp. Expr a -> SomeIndigoState inp)
    -> Expr a
    -> Instruction

----------------------------------------------------------------------------
-- Translations
----------------------------------------------------------------------------

-- | Data type internally used to collect 'Instruction's from 'IndigoM'
data InstrCollector = InstrCollector
  { InstrCollector -> RefId
nextRef   :: RefId
  , InstrCollector -> Block
instrList :: Block
  , InstrCollector -> SequentialHooks
seqHooks  :: SequentialHooks
  }

newtype SequentialHooks = SequentialHooks {
    SequentialHooks -> CallStack -> Block -> State InstrCollector ()
shStmtHook    :: CallStack -> Block -> State InstrCollector ()
  }

instance Semigroup SequentialHooks where
  SequentialHooks s :: CallStack -> Block -> State InstrCollector ()
s <> :: SequentialHooks -> SequentialHooks -> SequentialHooks
<> SequentialHooks s1 :: CallStack -> Block -> State InstrCollector ()
s1 = (CallStack -> Block -> State InstrCollector ()) -> SequentialHooks
SequentialHooks (\t :: CallStack
t -> CallStack -> Block -> State InstrCollector ()
s CallStack
t (Block -> State InstrCollector ())
-> (Block -> State InstrCollector ())
-> Block
-> State InstrCollector ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CallStack -> Block -> State InstrCollector ()
s1 CallStack
t)

instance Monoid SequentialHooks where
  mempty :: SequentialHooks
mempty = (CallStack -> Block -> State InstrCollector ()) -> SequentialHooks
SequentialHooks ((Block -> State InstrCollector ())
-> CallStack -> Block -> State InstrCollector ()
forall a b. a -> b -> a
const ((Block -> State InstrCollector ())
 -> CallStack -> Block -> State InstrCollector ())
-> (Block -> State InstrCollector ())
-> CallStack
-> Block
-> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Block -> State InstrCollector ()
appendNewInstrs (Block -> State InstrCollector ())
-> (Block -> Block) -> Block -> State InstrCollector ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Block
forall a. [a] -> [a]
reverse)

-- | Transformation from 'IndigoM' to a 'Block' of 'Instruction's.
--
-- Requires the first non-used 'RefId' and returns the next one.
indigoMtoSequential
  :: RefId
  -> SequentialHooks
  -> IndigoM a
  -> (Block, RefId)
indigoMtoSequential :: RefId -> SequentialHooks -> IndigoM a -> (Block, RefId)
indigoMtoSequential refId :: RefId
refId hook :: SequentialHooks
hook code :: IndigoM a
code =
  let InstrCollector {..} = (a, InstrCollector) -> InstrCollector
forall a b. (a, b) -> b
snd ((a, InstrCollector) -> InstrCollector)
-> (a, InstrCollector) -> InstrCollector
forall a b. (a -> b) -> a -> b
$ RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
forall a.
RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
instrCollect RefId
refId SequentialHooks
hook IndigoM a
code
  in (Block
instrList, RefId
nextRef)

-- | Collects instructions starting from an 'IndigoM'.
-- Returns an 'InstrCollector' as well as the return value for that 'IndigoM'.
instrCollect :: RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
instrCollect :: RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
instrCollect ref :: RefId
ref hooks :: SequentialHooks
hooks (IndigoM imCode :: Program (StatementF IndigoM) a
imCode) =
  let instrColl :: InstrCollector
instrColl = RefId -> Block -> SequentialHooks -> InstrCollector
InstrCollector RefId
ref [] SequentialHooks
hooks
      (res :: a
res, resColl :: InstrCollector
resColl) = InstrCollector -> State InstrCollector a -> (a, InstrCollector)
forall s a. s -> State s a -> (a, s)
usingState InstrCollector
instrColl (State InstrCollector a -> (a, InstrCollector))
-> State InstrCollector a -> (a, InstrCollector)
forall a b. (a -> b) -> a -> b
$ (forall x.
 StatementF IndigoM x -> StateT InstrCollector Identity x)
-> Program (StatementF IndigoM) a -> State InstrCollector a
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
(forall x. instr x -> m x) -> Program instr a -> m a
interpretProgram forall x. StatementF IndigoM x -> StateT InstrCollector Identity x
collectStatement Program (StatementF IndigoM) a
imCode
  in (a
res, RefId -> Block -> SequentialHooks -> InstrCollector
InstrCollector (InstrCollector -> RefId
nextRef InstrCollector
resColl) (Block -> Block
forall a. [a] -> [a]
reverse (Block -> Block) -> Block -> Block
forall a b. (a -> b) -> a -> b
$ InstrCollector -> Block
instrList InstrCollector
resColl) SequentialHooks
hooks)

-- | Collects instructions starting from 'S.StatementF'.
-- IMPORTANT: the instructions are collected in the opposite order (as a stack).
collectStatement :: S.StatementF IndigoM a -> State InstrCollector a
collectStatement :: StatementF IndigoM a -> State InstrCollector a
collectStatement = \case
  S.LiftIndigoState is :: forall (inp :: [*]). SomeIndigoState inp
is -> Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ (forall (inp :: [*]). SomeIndigoState inp) -> Instruction
LiftIndigoState forall (inp :: [*]). SomeIndigoState inp
is
  S.CalledFrom callStk :: CallStack
callStk iM :: IndigoM a
iM -> do
    InstrCollector nRef :: RefId
nRef _prevInstrs :: Block
_prevInstrs hooks :: SequentialHooks
hooks <- StateT InstrCollector Identity InstrCollector
forall s (m :: * -> *). MonadState s m => m s
get
    let (res :: a
res, inner :: InstrCollector
inner) = RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
forall a.
RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
instrCollect RefId
nRef SequentialHooks
hooks IndigoM a
iM
    (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InstrCollector -> InstrCollector) -> State InstrCollector ())
-> (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ \s :: InstrCollector
s -> InstrCollector
s {nextRef :: RefId
nextRef = InstrCollector -> RefId
nextRef InstrCollector
inner}
    a
res a -> State InstrCollector () -> State InstrCollector a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SequentialHooks -> CallStack -> Block -> State InstrCollector ()
shStmtHook SequentialHooks
hooks CallStack
callStk (InstrCollector -> Block
instrList InstrCollector
inner)
  S.NewVar ex :: Expr x
ex -> do
    Var x
var <- State InstrCollector (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Var x -> Expr x -> Instruction
forall x. KnownValue x => Var x -> Expr x -> Instruction
AssignVar Var x
var Expr x
ex
    Var x -> State InstrCollector (Var x)
forall (m :: * -> *) a. Monad m => a -> m a
return Var x
var
  S.SetVar vx :: Var x
vx ex :: Expr x
ex -> Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Var x -> Expr x -> Instruction
forall x. KnownValue x => Var x -> Expr x -> Instruction
SetVar Var x
vx Expr x
ex
  S.VarModification upd :: '[y, x] :-> '[x]
upd vx :: Var x
vx ey :: Expr y
ey -> Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ ('[y, x] :-> '[x]) -> Var x -> Expr y -> Instruction
forall x store.
(IsObject x, KnownValue store) =>
('[store, x] :-> '[x]) -> Var x -> Expr store -> Instruction
VarModification '[y, x] :-> '[x]
upd Var x
vx Expr y
ey
  S.SetField vStore :: Var dt
vStore fname :: Label fname
fname exF :: Expr ftype
exF -> Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Var dt -> Label fname -> Expr ftype -> Instruction
forall store (fname :: Symbol) ftype.
(HasField store fname ftype, IsObject store, IsObject ftype) =>
Var store -> Label fname -> Expr ftype -> Instruction
SetField Var dt
vStore Label fname
fname Expr ftype
exF

  S.LambdaCall1 lKind :: LambdaKind st arg res extra
lKind lName :: String
lName vIm :: Var arg -> IndigoM res
vIm ex :: Expr arg
ex -> LambdaKind st arg res extra
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
     CreateLambda1CGeneric extra arg res) =>
    State InstrCollector a)
-> State InstrCollector a
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
lKind (((ScopeCodeGen res, KnownValue arg, Typeable res,
   CreateLambda1CGeneric extra arg res) =>
  State InstrCollector a)
 -> State InstrCollector a)
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
     CreateLambda1CGeneric extra arg res) =>
    State InstrCollector a)
-> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ do
    (var :: Var arg
var, block :: Block
block, ret :: res
ret, retVars :: a
retVars) <- (Var arg -> IndigoM res)
-> State InstrCollector (Var arg, Block, res, RetVars res)
forall k ret (arg :: k).
ScopeCodeGen ret =>
(Var arg -> IndigoM ret)
-> State InstrCollector (Var arg, Block, ret, RetVars ret)
collectInLambda Var arg -> IndigoM res
vIm
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ LambdaKind st arg res extra
-> String
-> Expr arg
-> Var arg
-> Block
-> res
-> RetVars res
-> Instruction
forall st arg ret (extra :: [*]).
LambdaKind st arg ret extra
-> String
-> Expr arg
-> Var arg
-> Block
-> ret
-> RetVars ret
-> Instruction
LambdaCall1 LambdaKind st arg res extra
lKind String
lName Expr arg
ex Var arg
var Block
block res
ret a
RetVars res
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars

  S.Scope (IndigoM a
iM :: IndigoM ret) -> do
    a
retVars <- (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars a)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    (ret :: a
ret, block :: Block
block) <- IndigoM a -> State InstrCollector (a, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM a
iM
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Block -> a -> RetVars a -> Instruction
forall ret.
ScopeCodeGen ret =>
Block -> ret -> RetVars ret -> Instruction
Scope Block
block a
ret a
RetVars a
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars
  S.If ex :: Expr Bool
ex (IndigoM a
iMa :: IndigoM ret) iMb :: IndigoM b
iMb -> do
    a
retVars <- (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars a)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    (retA :: a
retA, blockA :: Block
blockA) <- IndigoM a -> State InstrCollector (a, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM a
iMa
    (retB :: b
retB, blockB :: Block
blockB) <- IndigoM b -> State InstrCollector (b, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM b
iMb
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr Bool -> Block -> a -> Block -> b -> RetVars a -> Instruction
forall a a.
IfConstraint a a =>
Expr Bool -> Block -> a -> Block -> a -> RetVars a -> Instruction
If Expr Bool
ex Block
blockA a
retA Block
blockB b
retB a
RetVars a
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars
  S.IfSome ex :: Expr (Maybe x)
ex (Var x -> IndigoM a
vIMa :: Var x -> IndigoM ret) iMb :: IndigoM b
iMb -> do
    a
retVars <- (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars a)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Var x
varX <- State InstrCollector (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    (retA :: a
retA, blockA :: Block
blockA) <- IndigoM a -> State InstrCollector (a, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM a -> State InstrCollector (a, Block))
-> IndigoM a -> State InstrCollector (a, Block)
forall a b. (a -> b) -> a -> b
$ Var x -> IndigoM a
vIMa Var x
varX
    (retB :: b
retB, blockB :: Block
blockB) <- IndigoM b -> State InstrCollector (b, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM b
iMb
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr (Maybe x)
-> Var x -> Block -> a -> Block -> b -> RetVars a -> Instruction
forall a b x.
(IfConstraint a b, KnownValue x) =>
Expr (Maybe x)
-> Var x -> Block -> a -> Block -> b -> RetVars a -> Instruction
IfSome Expr (Maybe x)
ex Var x
varX Block
blockA a
retA Block
blockB b
retB a
RetVars a
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars
  S.IfRight ex :: Expr (Either y x)
ex (Var x -> IndigoM a
vIMa :: Var x -> IndigoM ret) vIMb :: Var y -> IndigoM b
vIMb -> do
    a
retVars <- (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars a)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Var x
varR <- State InstrCollector (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    (retA :: a
retA, blockA :: Block
blockA) <- IndigoM a -> State InstrCollector (a, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM a -> State InstrCollector (a, Block))
-> IndigoM a -> State InstrCollector (a, Block)
forall a b. (a -> b) -> a -> b
$ Var x -> IndigoM a
vIMa Var x
varR
    Var y
varL <- State InstrCollector (Var y)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    (retB :: b
retB, blockB :: Block
blockB) <- IndigoM b -> State InstrCollector (b, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM b -> State InstrCollector (b, Block))
-> IndigoM b -> State InstrCollector (b, Block)
forall a b. (a -> b) -> a -> b
$ Var y -> IndigoM b
vIMb Var y
varL
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr (Either y x)
-> Var x
-> Block
-> a
-> Var y
-> Block
-> b
-> RetVars a
-> Instruction
forall a b a b.
(IfConstraint a b, KnownValue a, KnownValue b) =>
Expr (Either b a)
-> Var a
-> Block
-> a
-> Var b
-> Block
-> b
-> RetVars a
-> Instruction
IfRight Expr (Either y x)
ex Var x
varR Block
blockA a
retA Var y
varL Block
blockB b
retB a
RetVars a
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars
  S.IfCons ex :: Expr (List x)
ex (Var x -> Var (List x) -> IndigoM a
vvIMa :: Var x -> Var (List x) -> IndigoM ret) iMb :: IndigoM b
iMb -> do
    a
retVars <- (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars a)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Var x
varX <- State InstrCollector (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Var (List x)
varLX <- State InstrCollector (Var (List x))
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    (retA :: a
retA, blockA :: Block
blockA) <- IndigoM a -> State InstrCollector (a, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM a -> State InstrCollector (a, Block))
-> IndigoM a -> State InstrCollector (a, Block)
forall a b. (a -> b) -> a -> b
$ Var x -> Var (List x) -> IndigoM a
vvIMa Var x
varX Var (List x)
varLX
    (retB :: b
retB, blockB :: Block
blockB) <- IndigoM b -> State InstrCollector (b, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM b
iMb
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr (List x)
-> Var x
-> Var (List x)
-> Block
-> a
-> Block
-> b
-> RetVars a
-> Instruction
forall a b x.
(IfConstraint a b, KnownValue x) =>
Expr (List x)
-> Var x
-> Var (List x)
-> Block
-> a
-> Block
-> b
-> RetVars a
-> Instruction
IfCons Expr (List x)
ex Var x
varX Var (List x)
varLX Block
blockA a
retA Block
blockB b
retB a
RetVars a
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars

  S.Case grd :: Expr dt
grd clauses :: clauses
clauses -> do
    a
retVars <- Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
-> State InstrCollector (RetVars ret)
forall ret (dt :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (RetVars ret)
allocateClausesVars clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
clauses
    Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses <- Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
-> State
     InstrCollector
     (Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt)))
forall ret (dt :: [CaseClauseParam]).
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
collectClauses clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
clauses
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr dt
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> RetVars ret
-> Instruction
forall dt ret clauses.
CaseCommon dt ret clauses =>
Expr dt -> clauses -> RetVars ret -> Instruction
Case Expr dt
grd Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses a
RetVars ret
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars
  S.EntryCase proxy :: Proxy entrypointKind
proxy grd :: Expr dt
grd clauses :: clauses
clauses -> do
    a
retVars <- Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
-> State InstrCollector (RetVars ret)
forall ret (dt :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (RetVars ret)
allocateClausesVars clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
clauses
    Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses <- Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
-> State
     InstrCollector
     (Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt)))
forall ret (dt :: [CaseClauseParam]).
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
collectClauses clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
clauses
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Proxy entrypointKind
-> Expr dt
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> RetVars ret
-> Instruction
forall dt ret dt ret.
(CaseCommon dt ret dt, DocumentEntrypoints ret dt) =>
Proxy ret -> Expr dt -> dt -> RetVars ret -> Instruction
EntryCase Proxy entrypointKind
proxy Expr dt
grd Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses a
RetVars ret
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars
  S.EntryCaseSimple grd :: Expr cp
grd clauses :: clauses
clauses -> do
    a
retVars <- Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep cp))
-> State InstrCollector (RetVars ret)
forall ret (dt :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (RetVars ret)
allocateClausesVars clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep cp))
clauses
    Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep cp))
blockClauses <- Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep cp))
-> State
     InstrCollector
     (Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep cp)))
forall ret (dt :: [CaseClauseParam]).
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
collectClauses clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep cp))
clauses
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr cp
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep cp))
-> RetVars ret
-> Instruction
forall dt ret clauses.
(CaseCommon dt ret clauses,
 DocumentEntrypoints PlainEntrypointsKind dt, NiceParameterFull dt,
 RequireFlatParamEps dt) =>
Expr dt -> clauses -> RetVars ret -> Instruction
EntryCaseSimple Expr cp
grd Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep cp))
blockClauses a
RetVars ret
retVars
    a -> State InstrCollector a
forall (m :: * -> *) a. Monad m => a -> m a
return a
retVars

  S.While ex :: Expr Bool
ex iM :: IndigoM ()
iM -> do
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM ()
iM
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Expr Bool -> Block -> Instruction
While Expr Bool
ex Block
block
  S.WhileLeft ex :: Expr (Either y x)
ex vIm :: Var y -> IndigoM ()
vIm -> do
    Var y
varL <- State InstrCollector (Var y)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Var x
varR <- State InstrCollector (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM () -> State InstrCollector ((), Block))
-> IndigoM () -> State InstrCollector ((), Block)
forall a b. (a -> b) -> a -> b
$ Var y -> IndigoM ()
vIm Var y
varL
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Expr (Either y x) -> Var y -> Block -> Var x -> Instruction
forall l a.
(KnownValue l, KnownValue a) =>
Expr (Either l a) -> Var l -> Block -> Var a -> Instruction
WhileLeft Expr (Either y x)
ex Var y
varL Block
block Var x
varR
    Var x -> State InstrCollector (Var x)
forall (m :: * -> *) a. Monad m => a -> m a
return Var x
varR
  S.ForEach ex :: Expr a
ex vIm :: Var (IterOpElHs a) -> IndigoM ()
vIm -> do
    Var (IterOpElHs a)
varIop <- State InstrCollector (Var (IterOpElHs a))
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM () -> State InstrCollector ((), Block))
-> IndigoM () -> State InstrCollector ((), Block)
forall a b. (a -> b) -> a -> b
$ Var (IterOpElHs a) -> IndigoM ()
vIm Var (IterOpElHs a)
varIop
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Expr a -> Var (IterOpElHs a) -> Block -> Instruction
forall a.
(IterOpHs a, KnownValue (IterOpElHs a)) =>
Expr a -> Var (IterOpElHs a) -> Block -> Instruction
ForEach Expr a
ex Var (IterOpElHs a)
varIop Block
block

  S.ContractName tx :: Text
tx iM :: IndigoM ()
iM -> do
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM ()
iM
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Text -> Block -> Instruction
ContractName Text
tx Block
block
  S.DocGroup dg :: SubDoc -> di
dg iM :: IndigoM ()
iM -> do
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM ()
iM
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ (SubDoc -> di) -> Block -> Instruction
forall di. DocItem di => (SubDoc -> di) -> Block -> Instruction
DocGroup SubDoc -> di
dg Block
block
  S.ContractGeneral iM :: IndigoM ()
iM -> do
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner IndigoM ()
iM
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Block -> Instruction
ContractGeneral Block
block
  S.FinalizeParamCallingDoc vIm :: Var cp -> IndigoM ()
vIm param :: Expr cp
param -> do
    Var cp
varCp <- State InstrCollector (Var cp)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    ((), block :: Block
block) <- IndigoM () -> State InstrCollector ((), Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM () -> State InstrCollector ((), Block))
-> IndigoM () -> State InstrCollector ((), Block)
forall a b. (a -> b) -> a -> b
$ Var cp -> IndigoM ()
vIm Var cp
varCp
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Var cp -> Block -> Expr cp -> Instruction
forall cp.
(NiceParameterFull cp, RequireSumType cp) =>
Var cp -> Block -> Expr cp -> Instruction
FinalizeParamCallingDoc Var cp
varCp Block
block Expr cp
param

  S.TransferTokens ex :: Expr p
ex exm :: Expr Mutez
exm exc :: Expr (ContractRef p)
exc ->
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ Expr p -> Expr Mutez -> Expr (ContractRef p) -> Instruction
forall p.
(NiceParameter p, HasSideEffects) =>
Expr p -> Expr Mutez -> Expr (ContractRef p) -> Instruction
TransferTokens Expr p
ex Expr Mutez
exm Expr (ContractRef p)
exc
  S.SetDelegate ex :: Expr (Maybe KeyHash)
ex ->
    Instruction -> State InstrCollector a
Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector a)
-> Instruction -> State InstrCollector a
forall a b. (a -> b) -> a -> b
$ HasSideEffects => Expr (Maybe KeyHash) -> Instruction
Expr (Maybe KeyHash) -> Instruction
SetDelegate Expr (Maybe KeyHash)
ex
  S.CreateContract ctrc :: Contract param st
ctrc exk :: Expr (Maybe KeyHash)
exk exm :: Expr Mutez
exm exs :: Expr st
exs -> do
    Var Address
varAddr <- State InstrCollector (Var Address)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Contract param st
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr st
-> Var Address
-> Instruction
forall s p.
(HasSideEffects, NiceStorage s, NiceParameterFull p) =>
Contract p s
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> Instruction
CreateContract Contract param st
ctrc Expr (Maybe KeyHash)
exk Expr Mutez
exm Expr st
exs Var Address
varAddr
    Var Address -> State InstrCollector (Var Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Var Address
varAddr
  S.SelfCalling proxy :: Proxy p
proxy ep :: EntrypointRef mname
ep -> do
    Var (ContractRef (GetEntrypointArgCustom p mname))
varCR <- State
  InstrCollector (Var (ContractRef (GetEntrypointArgCustom p mname)))
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Proxy p
-> EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> Instruction
forall p (cp :: Maybe Symbol).
(NiceParameterFull p, KnownValue (GetEntrypointArgCustom p cp)) =>
Proxy p
-> EntrypointRef cp
-> Var (ContractRef (GetEntrypointArgCustom p cp))
-> Instruction
SelfCalling Proxy p
proxy EntrypointRef mname
ep Var (ContractRef (GetEntrypointArgCustom p mname))
varCR
    Var (ContractRef (GetEntrypointArgCustom p mname))
-> State
     InstrCollector (Var (ContractRef (GetEntrypointArgCustom p mname)))
forall (m :: * -> *) a. Monad m => a -> m a
return Var (ContractRef (GetEntrypointArgCustom p mname))
varCR
  S.ContractCalling proxy :: Proxy cp
proxy epRef :: epRef
epRef exAddr :: Expr addr
exAddr -> do
    Var (Maybe (ContractRef epArg))
varMcr <- State InstrCollector (Var (Maybe (ContractRef epArg)))
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ Proxy cp
-> epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> Instruction
forall cp epRef epArg addr.
(HasEntrypointArg cp epRef epArg, ToTAddress cp addr,
 ToT addr ~ ToT Address, KnownValue epArg) =>
Proxy cp
-> epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> Instruction
ContractCalling Proxy cp
proxy epRef
epRef Expr addr
exAddr Var (Maybe (ContractRef epArg))
varMcr
    Var (Maybe (ContractRef epArg))
-> State InstrCollector (Var (Maybe (ContractRef epArg)))
forall (m :: * -> *) a. Monad m => a -> m a
return Var (Maybe (ContractRef epArg))
varMcr

  S.Fail (Proxy ret
_ :: Proxy ret) failure :: forall (inp :: [*]). SomeIndigoState inp
failure -> do
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ (forall (inp :: [*]). SomeIndigoState inp) -> Instruction
Fail forall (inp :: [*]). SomeIndigoState inp
failure
    -- Note: because this is a failing instr, this vars are effectively never used
    (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars ret)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
  S.FailOver (Proxy ret
_ :: Proxy ret) failure :: forall (inp :: [*]). Expr a -> SomeIndigoState inp
failure ex :: Expr a
ex -> do
    Instruction -> State InstrCollector ()
appendNewInstr (Instruction -> State InstrCollector ())
-> Instruction -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ (forall (inp :: [*]). Expr a -> SomeIndigoState inp)
-> Expr a -> Instruction
forall a.
(forall (inp :: [*]). Expr a -> SomeIndigoState inp)
-> Expr a -> Instruction
FailOver forall (inp :: [*]). Expr a -> SomeIndigoState inp
failure Expr a
ex
    -- Note: because this is a failing instr, this vars are effectively never used
    (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars ret)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar

-- | Continues collecting 'Instruction's from an inner 'IndigoM' (e.g. scoped).
-- This keeps advancing the ref counter as well.
collectInner :: IndigoM ret -> State InstrCollector (ret, Block)
collectInner :: IndigoM ret -> State InstrCollector (ret, Block)
collectInner iM :: IndigoM ret
iM = do
  InstrCollector
iColl <- StateT InstrCollector Identity InstrCollector
forall s (m :: * -> *). MonadState s m => m s
get
  let (ret :: ret
ret, InstrCollector newRef :: RefId
newRef block :: Block
block _) = RefId -> SequentialHooks -> IndigoM ret -> (ret, InstrCollector)
forall a.
RefId -> SequentialHooks -> IndigoM a -> (a, InstrCollector)
instrCollect (InstrCollector -> RefId
nextRef InstrCollector
iColl) (InstrCollector -> SequentialHooks
seqHooks InstrCollector
iColl) IndigoM ret
iM
  InstrCollector -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (InstrCollector -> State InstrCollector ())
-> InstrCollector -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ InstrCollector
iColl {nextRef :: RefId
nextRef = RefId
newRef}
  (ret, Block) -> State InstrCollector (ret, Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (ret
ret, Block
block)

-- | Just a common set of steps used by collection of single-arg lambda's values.
collectInLambda
  :: ScopeCodeGen ret
  => (Var arg -> IndigoM ret)
  -> State InstrCollector (Var arg, Block, ret, RetVars ret)
collectInLambda :: (Var arg -> IndigoM ret)
-> State InstrCollector (Var arg, Block, ret, RetVars ret)
collectInLambda vIm :: Var arg -> IndigoM ret
vIm = do
  Var arg
var <- State InstrCollector (Var arg)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
  (ret
ret :: ret, block :: Block
block) <- IndigoM ret -> State InstrCollector (ret, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM ret -> State InstrCollector (ret, Block))
-> IndigoM ret -> State InstrCollector (ret, Block)
forall a b. (a -> b) -> a -> b
$ Var arg -> IndigoM ret
vIm Var arg
var
  RetVars ret
retVars <- (forall x. StateT InstrCollector Identity (Var x))
-> StateT InstrCollector Identity (RetVars ret)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
  (Var arg, Block, ret, RetVars ret)
-> State InstrCollector (Var arg, Block, ret, RetVars ret)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var arg
var, Block
block, ret
ret, RetVars ret
retVars)

-- | Append a new 'Instruction' to the head of the list in the state.
appendNewInstr :: Instruction -> State InstrCollector ()
appendNewInstr :: Instruction -> State InstrCollector ()
appendNewInstr is :: Instruction
is = (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InstrCollector -> InstrCollector) -> State InstrCollector ())
-> (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ \iColl :: InstrCollector
iColl -> InstrCollector
iColl {instrList :: Block
instrList = Instruction
is Instruction -> Block -> Block
forall a. a -> [a] -> [a]
: InstrCollector -> Block
instrList InstrCollector
iColl}

appendNewInstrs :: Block -> State InstrCollector ()
appendNewInstrs :: Block -> State InstrCollector ()
appendNewInstrs blk :: Block
blk = (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InstrCollector -> InstrCollector) -> State InstrCollector ())
-> (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ \iColl :: InstrCollector
iColl -> InstrCollector
iColl {instrList :: Block
instrList = Block
blk Block -> Block -> Block
forall a. [a] -> [a] -> [a]
++ InstrCollector -> Block
instrList InstrCollector
iColl}

-- | Creates a new var. This simply advances the ref counter and updates it.
mkNextVar :: State InstrCollector (Var a)
mkNextVar :: State InstrCollector (Var a)
mkNextVar = do
  InstrCollector
iColl <- StateT InstrCollector Identity InstrCollector
forall s (m :: * -> *). MonadState s m => m s
get
  let ref :: RefId
ref = InstrCollector -> RefId
nextRef InstrCollector
iColl
  InstrCollector -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (InstrCollector -> State InstrCollector ())
-> InstrCollector -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ InstrCollector
iColl {nextRef :: RefId
nextRef = RefId
ref RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ 1}
  Var a -> State InstrCollector (Var a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var a -> State InstrCollector (Var a))
-> Var a -> State InstrCollector (Var a)
forall a b. (a -> b) -> a -> b
$ RefId -> Var a
forall k (a :: k). RefId -> Var a
Var RefId
ref

-- | Translation from a 'Block' and an initial 'MetaData' to Lorentz.
sequentialToLorentz
  :: MetaData inp
  -> (Block, RefId)
  -> inp :-> inp
sequentialToLorentz :: MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz md :: MetaData inp
md block :: (Block, RefId)
block =
  SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]). GenCode inp out -> inp :-> inp)
-> inp :-> inp
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block, RefId)
block) MetaData inp
md forall (out :: [*]). GenCode inp out -> inp :-> inp
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> inp
St.cleanGenCode

-- | Translation from a 'Block' to a 'SomeIndigoState'.
sequentialToSIS :: (Block, RefId) -> SomeIndigoState inp
sequentialToSIS :: (Block, RefId) -> SomeIndigoState inp
sequentialToSIS ([], _) = IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS IndigoState inp inp
forall (inp :: [*]). IndigoState inp inp
St.nopState
sequentialToSIS (x :: Instruction
x : xs :: Block
xs, refId :: RefId
refId) = RefId -> Instruction -> SomeIndigoState inp
forall (inp :: [*]). RefId -> Instruction -> SomeIndigoState inp
instrToSIS RefId
refId Instruction
x SomeIndigoState inp
-> (forall (inp :: [*]). SomeIndigoState inp)
-> SomeIndigoState inp
forall (inp :: [*]).
SomeIndigoState inp
-> (forall (inp :: [*]). SomeIndigoState inp)
-> SomeIndigoState inp
`thenSIS` (Block, RefId) -> SomeIndigoState out
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
xs, RefId
refId)

-- | Translation from a single 'Instruction' to a 'SomeIndigoState'.
instrToSIS :: RefId -> Instruction -> SomeIndigoState inp
instrToSIS :: RefId -> Instruction -> SomeIndigoState inp
instrToSIS nextRef :: RefId
nextRef = \case
  LiftIndigoState sis :: forall (inp :: [*]). SomeIndigoState inp
sis -> SomeIndigoState inp
forall (inp :: [*]). SomeIndigoState inp
sis
  Comment txt :: Text
txt -> IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ CommentType -> IndigoState inp inp
forall (i :: [*]). CommentType -> IndigoState i i
comment (CommentType -> IndigoState inp inp)
-> CommentType -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ Text -> CommentType
MT.JustComment Text
txt
  AssignVar vx :: Var x
vx ex :: Expr x
ex -> IndigoState inp (x : inp) -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (x : inp) -> SomeIndigoState inp)
-> IndigoState inp (x : inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Var x -> Expr x -> IndigoState inp (x : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> Expr x -> IndigoState inp (x : inp)
assignVar Var x
vx Expr x
ex
  SetVar vx :: Var x
vx ex :: Expr x
ex -> IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ RefId -> Var x -> Expr x -> IndigoState inp inp
forall a (inp :: [*]).
KnownValue a =>
RefId -> Var a -> Expr a -> IndigoState inp inp
setVar RefId
nextRef Var x
vx Expr x
ex
  VarModification upd :: '[y, x] :-> '[x]
upd vx :: Var x
vx ey :: Expr y
ey -> IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ RefId
-> ('[y, x] :-> '[x]) -> Var x -> Expr y -> IndigoState inp inp
forall x y (inp :: [*]).
(IsObject x, KnownValue y) =>
RefId
-> ('[y, x] :-> '[x]) -> Var x -> Expr y -> IndigoState inp inp
updateVar RefId
nextRef '[y, x] :-> '[x]
upd Var x
vx Expr y
ey
  SetField vSt :: Var store
vSt lName :: Label fname
lName ex :: Expr ftype
ex -> IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ RefId
-> Var store -> Label fname -> Expr ftype -> IndigoState inp inp
forall dt (fname :: Symbol) ftype (inp :: [*]).
(IsObject dt, IsObject ftype, HasField dt fname ftype) =>
RefId -> Var dt -> Label fname -> Expr ftype -> IndigoState inp inp
setField RefId
nextRef Var store
vSt Label fname
lName Expr ftype
ex

  LambdaCall1 lKind :: LambdaKind st arg ret extra
lKind _lName :: String
_lName ex :: Expr arg
ex var :: Var arg
var block :: Block
block ret :: ret
ret retVars :: RetVars ret
retVars ->
    LambdaKind st arg ret extra
-> ((ScopeCodeGen ret, KnownValue arg, Typeable ret,
     CreateLambda1CGeneric extra arg ret) =>
    SomeIndigoState inp)
-> SomeIndigoState 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 ret extra
lKind (((ScopeCodeGen ret, KnownValue arg, Typeable ret,
   CreateLambda1CGeneric extra arg ret) =>
  SomeIndigoState inp)
 -> SomeIndigoState inp)
-> ((ScopeCodeGen ret, KnownValue arg, Typeable ret,
     CreateLambda1CGeneric extra arg ret) =>
    SomeIndigoState inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$
      IndigoState inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ SomeIndigoState inp
-> ret
-> RetVars ret
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
SomeIndigoState inp
-> ret -> RetVars ret -> IndigoState inp (RetOutStack ret ++ inp)
scope ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Var arg -> Expr arg -> Instruction
forall x. KnownValue x => Var x -> Expr x -> Instruction
AssignVar Var arg
var Expr arg
ex Instruction -> Block -> Block
forall a. a -> [a] -> [a]
: Block
block, RefId
nextRef)) ret
ret RetVars ret
retVars
  CreateLambda1 lamMd :: StackVars (arg : extra)
lamMd _var :: Var arg
_var body :: Block
body ret :: ret
ret varLam :: Var (Lambda1Generic extra arg ret)
varLam ->
    IndigoState inp (Lambda1Generic extra arg ret : inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (Lambda1Generic extra arg ret : inp)
 -> SomeIndigoState inp)
-> IndigoState inp (Lambda1Generic extra arg ret : inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Var (Lambda1Generic extra arg ret)
-> ret
-> StackVars (arg : extra)
-> SomeIndigoState (arg : extra)
-> IndigoState inp (Lambda1Generic extra arg ret : inp)
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 ret)
varLam ret
ret StackVars (arg : extra)
lamMd ((Block, RefId) -> SomeIndigoState (arg : extra)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
body, RefId
nextRef))
  ExecLambda1 lKind :: LambdaKind st arg ret extra
lKind (Proxy ret
Proxy :: Proxy ret) ex :: Expr arg
ex varLam :: Var (Lambda1Generic extra arg ret)
varLam retVars :: RetVars ret
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ LambdaKind st arg ret extra
-> RefId -> RetVars ret -> LambdaExecutor extra arg ret inp
forall res st arg (extra :: [*]) (inp :: [*]).
LambdaKind st arg res extra
-> RefId -> RetVars res -> LambdaExecutor extra arg res inp
executeLambda1 @ret LambdaKind st arg ret extra
lKind RefId
nextRef RetVars ret
retVars Var (Lambda1Generic extra arg ret)
varLam Expr arg
ex

  Scope block :: Block
block ret :: ret
ret retVars :: RetVars ret
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ SomeIndigoState inp
-> ret
-> RetVars ret
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
SomeIndigoState inp
-> ret -> RetVars ret -> IndigoState inp (RetOutStack ret ++ inp)
scope ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef)) ret
ret RetVars ret
retVars
  If ex :: Expr Bool
ex blockA :: Block
blockA retA :: a
retA blockB :: Block
blockB retB :: b
retB retVars :: RetVars a
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
 -> SomeIndigoState inp)
-> IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr Bool
-> SomeIndigoState inp
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
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
ex ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockA, RefId
nextRef)) a
retA ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockB, RefId
nextRef)) b
retB RetVars a
retVars
  IfSome ex :: Expr (Maybe x)
ex varX :: Var x
varX blockA :: Block
blockA retA :: a
retA blockB :: Block
blockB retB :: b
retB retVars :: RetVars a
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
 -> SomeIndigoState inp)
-> IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr (Maybe x)
-> Var x
-> SomeIndigoState (x : inp)
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
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)
ex Var x
varX ((Block, RefId) -> SomeIndigoState (x : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockA, RefId
nextRef)) a
retA ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockB, RefId
nextRef)) b
retB RetVars a
retVars
  IfRight ex :: Expr (Either l r)
ex varR :: Var r
varR blockA :: Block
blockA retA :: a
retA varL :: Var l
varL blockB :: Block
blockB retB :: b
retB retVars :: RetVars a
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
 -> SomeIndigoState inp)
-> IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr (Either l r)
-> Var r
-> SomeIndigoState (r : inp)
-> a
-> Var l
-> SomeIndigoState (l : inp)
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
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)
ex Var r
varR ((Block, RefId) -> SomeIndigoState (r : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockA, RefId
nextRef)) a
retA Var l
varL ((Block, RefId) -> SomeIndigoState (l : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockB, RefId
nextRef)) b
retB RetVars a
retVars
  IfCons ex :: Expr (List x)
ex varX :: Var x
varX varLX :: Var (List x)
varLX blockA :: Block
blockA retA :: a
retA blockB :: Block
blockB retB :: b
retB retVars :: RetVars a
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
 -> SomeIndigoState inp)
-> IndigoState inp (RetOutStack' (ClassifyReturnValue b) b ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr (List x)
-> Var x
-> Var (List x)
-> SomeIndigoState (x : List x : inp)
-> a
-> SomeIndigoState inp
-> b
-> RetVars a
-> IndigoState inp (RetOutStack a ++ inp)
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)
ex Var x
varX Var (List x)
varLX ((Block, RefId) -> SomeIndigoState (x : List x : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockA, RefId
nextRef)) a
retA ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
blockB, RefId
nextRef)) b
retB RetVars a
retVars

  Case grd :: Expr dt
grd blockClauses :: clauses
blockClauses retVars :: RetVars ret
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr dt
-> Rec (IndigoCaseClauseL ret) (GCaseClauses (Rep dt))
-> RetVars ret
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall dt (inp :: [*]) ret clauses.
CaseCommon dt ret clauses =>
Expr dt
-> clauses
-> RetVars ret
-> IndigoState inp (RetOutStack ret ++ inp)
caseRec Expr dt
grd (RefId
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> Rec (IndigoCaseClauseL ret) (GCaseClauses (Rep dt))
forall ret (dt :: [CaseClauseParam]).
RMap dt =>
RefId
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoCaseClauseL ret) dt
clausesToBackend RefId
nextRef clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses) RetVars ret
retVars
  EntryCase proxy :: Proxy entryPointKind
proxy grd :: Expr dt
grd blockClauses :: clauses
blockClauses retVars :: RetVars ret
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Proxy entryPointKind
-> Expr dt
-> Rec (IndigoCaseClauseL ret) (GCaseClauses (Rep dt))
-> RetVars ret
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall dt entrypointKind (inp :: [*]) ret clauses.
(CaseCommon dt ret clauses,
 DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Expr dt
-> clauses
-> RetVars ret
-> IndigoState inp (RetOutStack ret ++ inp)
entryCaseRec Proxy entryPointKind
proxy Expr dt
grd (RefId
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> Rec (IndigoCaseClauseL ret) (GCaseClauses (Rep dt))
forall ret (dt :: [CaseClauseParam]).
RMap dt =>
RefId
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoCaseClauseL ret) dt
clausesToBackend RefId
nextRef clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses) RetVars ret
retVars
  EntryCaseSimple grd :: Expr dt
grd blockClauses :: clauses
blockClauses retVars :: RetVars ret
retVars ->
    IndigoState inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr dt
-> Rec (IndigoCaseClauseL ret) (GCaseClauses (Rep dt))
-> RetVars ret
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall dt (inp :: [*]) ret clauses.
(CaseCommon dt ret clauses,
 DocumentEntrypoints PlainEntrypointsKind dt, NiceParameterFull dt,
 RequireFlatParamEps dt) =>
Expr dt
-> clauses
-> RetVars ret
-> IndigoState inp (RetOutStack ret ++ inp)
entryCaseSimpleRec Expr dt
grd (RefId
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> Rec (IndigoCaseClauseL ret) (GCaseClauses (Rep dt))
forall ret (dt :: [CaseClauseParam]).
RMap dt =>
RefId
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoCaseClauseL ret) dt
clausesToBackend RefId
nextRef clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses) RetVars ret
retVars

  While ex :: Expr Bool
ex block :: Block
block ->
    IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr Bool -> SomeIndigoState inp -> IndigoState inp inp
forall (inp :: [*]).
Expr Bool -> SomeIndigoState inp -> IndigoState inp inp
while Expr Bool
ex ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef))
  WhileLeft ex :: Expr (Either l r)
ex varL :: Var l
varL block :: Block
block varR :: Var r
varR ->
    IndigoState inp (r : inp) -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (r : inp) -> SomeIndigoState inp)
-> IndigoState inp (r : inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr (Either l r)
-> Var l
-> SomeIndigoState (l : inp)
-> Var r
-> IndigoState inp (r : inp)
forall l r (inp :: [*]).
(KnownValue l, KnownValue r) =>
Expr (Either l r)
-> Var l
-> SomeIndigoState (l : inp)
-> Var r
-> IndigoState inp (r : inp)
whileLeft Expr (Either l r)
ex Var l
varL ((Block, RefId) -> SomeIndigoState (l : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef)) Var r
varR
  ForEach ex :: Expr a
ex varIop :: Var (IterOpElHs a)
varIop block :: Block
block ->
    IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr a
-> Var (IterOpElHs a)
-> SomeIndigoState (IterOpElHs a : inp)
-> IndigoState inp inp
forall a (inp :: [*]).
(IterOpHs a, KnownValue (IterOpElHs a)) =>
Expr a
-> Var (IterOpElHs a)
-> SomeIndigoState (IterOpElHs a : inp)
-> IndigoState inp inp
forEach Expr a
ex Var (IterOpElHs a)
varIop ((Block, RefId) -> SomeIndigoState (IterOpElHs a : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef))

  ContractName tx :: Text
tx block :: Block
block ->
    (SubDoc -> DName) -> SomeIndigoState inp -> SomeIndigoState inp
forall di (i :: [*]).
DocItem di =>
(SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup (Text -> SubDoc -> DName
DName Text
tx) ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef))
  DocGroup dg :: SubDoc -> di
dg block :: Block
block ->
    (SubDoc -> di) -> SomeIndigoState inp -> SomeIndigoState inp
forall di (i :: [*]).
DocItem di =>
(SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup SubDoc -> di
dg ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef))
  ContractGeneral block :: Block
block ->
    (SubDoc -> DGeneralInfoSection)
-> SomeIndigoState inp -> SomeIndigoState inp
forall di (i :: [*]).
DocItem di =>
(SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup SubDoc -> DGeneralInfoSection
DGeneralInfoSection ((Block, RefId) -> SomeIndigoState inp
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef))
  FinalizeParamCallingDoc varCp :: Var cp
varCp block :: Block
block param :: Expr cp
param ->
    Var cp
-> SomeIndigoState (cp : inp) -> Expr cp -> SomeIndigoState inp
forall cp (inp :: [*]).
(NiceParameterFull cp, RequireSumType cp, HasCallStack) =>
Var cp
-> SomeIndigoState (cp : inp) -> Expr cp -> SomeIndigoState inp
finalizeParamCallingDoc Var cp
varCp ((Block, RefId) -> SomeIndigoState (cp : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef)) Expr cp
param

  TransferTokens ex :: Expr p
ex exm :: Expr Mutez
exm exc :: Expr (ContractRef p)
exc ->
    IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr p -> Expr Mutez -> Expr (ContractRef p) -> IndigoState inp inp
forall p (inp :: [*]).
(NiceParameter p, HasSideEffects) =>
Expr p -> Expr Mutez -> Expr (ContractRef p) -> IndigoState inp inp
transferTokens Expr p
ex Expr Mutez
exm Expr (ContractRef p)
exc
  SetDelegate ex :: Expr (Maybe KeyHash)
ex ->
    IndigoState inp inp -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp inp -> SomeIndigoState inp)
-> IndigoState inp inp -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Expr (Maybe KeyHash) -> IndigoState inp inp
forall (inp :: [*]).
HasSideEffects =>
Expr (Maybe KeyHash) -> IndigoState inp inp
setDelegate Expr (Maybe KeyHash)
ex
  CreateContract ctrc :: Contract p s
ctrc exk :: Expr (Maybe KeyHash)
exk exm :: Expr Mutez
exm exs :: Expr s
exs varAddr :: Var Address
varAddr ->
    IndigoState inp (Address : inp) -> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (Address : inp) -> SomeIndigoState inp)
-> IndigoState inp (Address : inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ Contract p s
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> IndigoState inp (Address : inp)
forall s p (inp :: [*]).
(HasSideEffects, NiceStorage s, NiceParameterFull p) =>
Contract p s
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> IndigoState inp (Address : inp)
createContract Contract p s
ctrc Expr (Maybe KeyHash)
exk Expr Mutez
exm Expr s
exs Var Address
varAddr
  SelfCalling (Proxy p
Proxy :: Proxy p) ep :: EntrypointRef mname
ep varCR :: Var (ContractRef (GetEntrypointArgCustom p mname))
varCR ->
    IndigoState
  inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState
   inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
 -> SomeIndigoState inp)
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
forall p (inp :: [*]) (mname :: Maybe Symbol).
(NiceParameterFull p,
 KnownValue (GetEntrypointArgCustom p mname)) =>
EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
selfCalling @p EntrypointRef mname
ep Var (ContractRef (GetEntrypointArgCustom p mname))
varCR
  ContractCalling (Proxy cp
Proxy :: Proxy cp) epRef :: epRef
epRef exAddr :: Expr addr
exAddr varMcr :: Var (Maybe (ContractRef epArg))
varMcr ->
    IndigoState inp (Maybe (ContractRef epArg) : inp)
-> SomeIndigoState inp
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS (IndigoState inp (Maybe (ContractRef epArg) : inp)
 -> SomeIndigoState inp)
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
-> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
forall cp (inp :: [*]) epRef epArg addr.
(HasEntrypointArg cp epRef epArg, ToTAddress cp addr,
 ToT addr ~ ToT Address, KnownValue epArg) =>
epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
contractCalling @cp epRef
epRef Expr addr
exAddr Var (Maybe (ContractRef epArg))
varMcr

  Fail failure :: forall (inp :: [*]). SomeIndigoState inp
failure -> SomeIndigoState inp
forall (inp :: [*]). SomeIndigoState inp
failure
  FailOver failure :: forall (inp :: [*]). Expr a -> SomeIndigoState inp
failure ex :: Expr a
ex -> Expr a -> SomeIndigoState inp
forall (inp :: [*]). Expr a -> SomeIndigoState inp
failure Expr a
ex

----------------------------------------------------------------------------
-- Case machinery
----------------------------------------------------------------------------

-- | Common constraint for case-like 'Instruction's.
type CaseCommon dt ret clauses = CaseCommonF IndigoSeqCaseClause dt ret clauses

-- | Analogous datatype as 'IndigoCaseClauseL' and 'IndigoMCaseClauseL'.
data IndigoSeqCaseClause ret (param :: CaseClauseParam) where
  OneFieldIndigoSeqCaseClause
    :: (AppendSymbol "c" ctor ~ name)
    => Label name
    -> CaseBranch x ret
    -> IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))

-- | Representation of a branch of a generic case-like 'Instruction'.
data CaseBranch x ret where
  CaseBranch
    :: ( KnownValue x
       , ScopeCodeGen retBr
       , ret ~ RetExprs retBr
       , RetOutStack ret ~ RetOutStack retBr
       )
    => Var x
    -- ^ Input variable (accessible to the branch's code block)
    -> Block
    -- ^ Code block for this branch
    -> retBr
    -- ^ Return value of this branch
    -> CaseBranch x ret

-- | Convert clauses from their "sequential" representation to the "backend" one.
clausesToBackend
  :: forall ret dt . RMap dt
  => RefId
  -> Rec (IndigoSeqCaseClause ret) dt
  -> Rec (IndigoCaseClauseL ret) dt
clausesToBackend :: RefId
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoCaseClauseL ret) dt
clausesToBackend nextRef :: RefId
nextRef = (forall (x :: CaseClauseParam).
 IndigoSeqCaseClause ret x -> IndigoCaseClauseL ret x)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoCaseClauseL ret) dt
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap ((forall (x :: CaseClauseParam).
  IndigoSeqCaseClause ret x -> IndigoCaseClauseL ret x)
 -> Rec (IndigoSeqCaseClause ret) dt
 -> Rec (IndigoCaseClauseL ret) dt)
-> (forall (x :: CaseClauseParam).
    IndigoSeqCaseClause ret x -> IndigoCaseClauseL ret x)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoCaseClauseL ret) dt
forall a b. (a -> b) -> a -> b
$
  \(OneFieldIndigoSeqCaseClause cName (CaseBranch vx block ret)) ->
    Label name
cName Label name -> IndigoClause x ret -> IndigoCaseClauseL ret x
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> (Var x
-> (forall (inp :: [*]). SomeIndigoState (x : inp))
-> retBr
-> IndigoClause x ret
forall x retBr ret.
(KnownValue x, ScopeCodeGen retBr, ret ~ RetExprs retBr,
 RetOutStack ret ~ RetOutStack retBr) =>
Var x
-> (forall (inp :: [*]). SomeIndigoState (x : inp))
-> retBr
-> IndigoClause x ret
IndigoClause Var x
vx ((Block, RefId) -> SomeIndigoState (x : inp)
forall (inp :: [*]). (Block, RefId) -> SomeIndigoState inp
sequentialToSIS (Block
block, RefId
nextRef)) retBr
ret)

-- | Allocate vars for the return value(s) of a clause-like 'Instruction'.
allocateClausesVars
  :: forall ret dt. ReturnableValue ret
  => Rec (S.IndigoMCaseClauseL IndigoM ret) dt
  -> State InstrCollector (RetVars ret)
allocateClausesVars :: Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (RetVars ret)
allocateClausesVars _ = (forall x. StateT InstrCollector Identity (Var x))
-> State InstrCollector (RetVars ret)
forall ret (m :: * -> *).
(ReturnableValue ret, Monad m) =>
(forall x. m (Var x)) -> m (RetVars ret)
allocateVars @ret forall x. StateT InstrCollector Identity (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar

-- | Collects clauses of a case-like statement.
collectClauses
  :: Rec (S.IndigoMCaseClauseL IndigoM ret) dt
  -> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
collectClauses :: Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
collectClauses RNil = Rec (IndigoSeqCaseClause ret) '[]
-> StateT
     InstrCollector Identity (Rec (IndigoSeqCaseClause ret) '[])
forall (m :: * -> *) a. Monad m => a -> m a
return Rec (IndigoSeqCaseClause ret) '[]
forall u (a :: u -> *). Rec a '[]
RNil
collectClauses ((S.OneFieldIndigoMCaseClauseL cName :: Label name
cName clause :: Var x -> IndigoM retBr
clause) :& xs :: Rec (IndigoMCaseClauseL IndigoM ret) rs
xs) = do
  Var x
varX <- State InstrCollector (Var x)
forall k (a :: k). State InstrCollector (Var a)
mkNextVar
  (ret :: retBr
ret, block :: Block
block) <- IndigoM retBr -> State InstrCollector (retBr, Block)
forall ret. IndigoM ret -> State InstrCollector (ret, Block)
collectInner (IndigoM retBr -> State InstrCollector (retBr, Block))
-> IndigoM retBr -> State InstrCollector (retBr, Block)
forall a b. (a -> b) -> a -> b
$ Var x -> IndigoM retBr
clause Var x
varX
  let clauseX :: IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
clauseX = Label name
-> CaseBranch x ret
-> IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
forall (ctor :: Symbol) (name :: Symbol) x ret.
(AppendSymbol "c" ctor ~ name) =>
Label name
-> CaseBranch x ret
-> IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
OneFieldIndigoSeqCaseClause Label name
cName (Var x -> Block -> retBr -> CaseBranch x ret
forall x retBr ret.
(KnownValue x, ScopeCodeGen retBr, ret ~ RetExprs retBr,
 RetOutStack ret ~ RetOutStack retBr) =>
Var x -> Block -> retBr -> CaseBranch x ret
CaseBranch Var x
varX Block
block retBr
ret)
  Rec (IndigoSeqCaseClause ret) rs
clauseXs <- Rec (IndigoMCaseClauseL IndigoM ret) rs
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) rs)
forall ret (dt :: [CaseClauseParam]).
Rec (IndigoMCaseClauseL IndigoM ret) dt
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
collectClauses Rec (IndigoMCaseClauseL IndigoM ret) rs
xs
  Rec
  (IndigoSeqCaseClause ret)
  ('CaseClauseParam ctor ('OneField x) : rs)
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rec
   (IndigoSeqCaseClause ret)
   ('CaseClauseParam ctor ('OneField x) : rs)
 -> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt))
-> Rec
     (IndigoSeqCaseClause ret)
     ('CaseClauseParam ctor ('OneField x) : rs)
-> State InstrCollector (Rec (IndigoSeqCaseClause ret) dt)
forall a b. (a -> b) -> a -> b
$ IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
clauseX IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
-> Rec (IndigoSeqCaseClause ret) rs
-> Rec
     (IndigoSeqCaseClause ret)
     ('CaseClauseParam ctor ('OneField x) : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (IndigoSeqCaseClause ret) rs
clauseXs

-- | Applies the given 'Block' to 'Block' transformation to the inner code block
-- of every case clause.
updateClauses
  :: (Block -> Block)
  -> Rec (IndigoSeqCaseClause ret) dt
  -> Rec (IndigoSeqCaseClause ret) dt
updateClauses :: (Block -> Block)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoSeqCaseClause ret) dt
updateClauses _ RNil = Rec (IndigoSeqCaseClause ret) dt
forall u (a :: u -> *). Rec a '[]
RNil
updateClauses f :: Block -> Block
f (x :: IndigoSeqCaseClause ret r
x :& xs :: Rec (IndigoSeqCaseClause ret) rs
xs) = case IndigoSeqCaseClause ret r
x of
  OneFieldIndigoSeqCaseClause cName :: Label name
cName (CaseBranch vx :: Var x
vx block :: Block
block ret :: retBr
ret) ->
    Label name
-> CaseBranch x ret
-> IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
forall (ctor :: Symbol) (name :: Symbol) x ret.
(AppendSymbol "c" ctor ~ name) =>
Label name
-> CaseBranch x ret
-> IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
OneFieldIndigoSeqCaseClause Label name
cName (Var x -> Block -> retBr -> CaseBranch x ret
forall x retBr ret.
(KnownValue x, ScopeCodeGen retBr, ret ~ RetExprs retBr,
 RetOutStack ret ~ RetOutStack retBr) =>
Var x -> Block -> retBr -> CaseBranch x ret
CaseBranch Var x
vx (Block -> Block
f Block
block) retBr
ret)
      IndigoSeqCaseClause ret ('CaseClauseParam ctor ('OneField x))
-> Rec (IndigoSeqCaseClause ret) rs
-> Rec
     (IndigoSeqCaseClause ret)
     ('CaseClauseParam ctor ('OneField x) : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Block -> Block)
-> Rec (IndigoSeqCaseClause ret) rs
-> Rec (IndigoSeqCaseClause ret) rs
forall ret (dt :: [CaseClauseParam]).
(Block -> Block)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoSeqCaseClause ret) dt
updateClauses Block -> Block
f Rec (IndigoSeqCaseClause ret) rs
xs

-- | Applies the given monadic function giving it the inner code block of each
-- case clause, in order.
mapMClauses :: Monad m => (Block -> m ()) -> Rec (IndigoSeqCaseClause ret) dt -> m ()
mapMClauses :: (Block -> m ()) -> Rec (IndigoSeqCaseClause ret) dt -> m ()
mapMClauses _ RNil = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mapMClauses f :: Block -> m ()
f (x :: IndigoSeqCaseClause ret r
x :& xs :: Rec (IndigoSeqCaseClause ret) rs
xs) = case IndigoSeqCaseClause ret r
x of
  OneFieldIndigoSeqCaseClause _cName :: Label name
_cName (CaseBranch _ block :: Block
block _) ->
    Block -> m ()
f Block
block m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Block -> m ()) -> Rec (IndigoSeqCaseClause ret) rs -> m ()
forall (m :: * -> *) ret (dt :: [CaseClauseParam]).
Monad m =>
(Block -> m ()) -> Rec (IndigoSeqCaseClause ret) dt -> m ()
mapMClauses Block -> m ()
f Rec (IndigoSeqCaseClause ret) rs
xs

makeLensesFor [ ("shStmtHook", "stmtHookL")] ''SequentialHooks