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

module Indigo.Compilation.Lambda
  ( compileLambdas
  ) where

import Prelude

import qualified Data.Map as M

import Indigo.Backend as B
import Indigo.Compilation.Sequential
import Indigo.Internal.Var

-- | Collects named lambdas that are used more than once and separates them into
-- a lambda creation and multiple lambda executions.
-- Leaves the remaining lambdas untouched, to be compiled inline.
compileLambdas :: (Block, RefId) -> (Block, RefId)
compileLambdas :: (Block, RefId) -> (Block, RefId)
compileLambdas (block :: Block
block, nextRef :: RefId
nextRef) = (Block
mkLambdas Block -> Block -> Block
forall a. Semigroup a => a -> a -> a
<> Block
updatedBlock, RefId
newNextRef)
  where
    lambdaSet :: Set Lambda1Def
lambdaSet = Block -> Set Lambda1Def
collectNotInlinableLambdas Block
block
    (lambdaRefDefs :: [(Lambda1Def, RefId)]
lambdaRefDefs, newNextRef :: RefId
newNextRef) = RefId -> Set Lambda1Def -> ([(Lambda1Def, RefId)], RefId)
createLambdaRefs RefId
nextRef Set Lambda1Def
lambdaSet
    mkLambdas :: Block
mkLambdas = [(Lambda1Def, RefId)] -> Block
createAllLambdas [(Lambda1Def, RefId)]
lambdaRefDefs
    updatedBlock :: Block
updatedBlock = Block -> Map String RefId -> Block
updateBlock Block
block (Map String RefId -> Block)
-> ([(String, RefId)] -> Map String RefId)
-> [(String, RefId)]
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, RefId)] -> Map String RefId
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, RefId)] -> Block) -> [(String, RefId)] -> Block
forall a b. (a -> b) -> a -> b
$ ((Lambda1Def, RefId) -> (String, RefId))
-> [(Lambda1Def, RefId)] -> [(String, RefId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Lambda1Def -> String) -> (Lambda1Def, RefId) -> (String, RefId)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Lambda1Def -> String
ldName) [(Lambda1Def, RefId)]
lambdaRefDefs

-- | Collect all used lambdas in a computation that are called at least twice.
-- Only the outer lambdas will be gathered, for example, if we call lambda "func1"
-- from "func0", only "func0" will be considered.
collectNotInlinableLambdas :: Block -> Set Lambda1Def
collectNotInlinableLambdas :: Block -> Set Lambda1Def
collectNotInlinableLambdas = Map Lambda1Def Word -> Set Lambda1Def
forall k a. Map k a -> Set k
M.keysSet (Map Lambda1Def Word -> Set Lambda1Def)
-> (Block -> Map Lambda1Def Word) -> Block -> Set Lambda1Def
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Bool) -> Map Lambda1Def Word -> Map Lambda1Def Word
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Map Lambda1Def Word -> Map Lambda1Def Word)
-> (Block -> Map Lambda1Def Word) -> Block -> Map Lambda1Def Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Lambda1Def Word
-> State (Map Lambda1Def Word) () -> Map Lambda1Def Word
forall s a. s -> State s a -> s
executingState Map Lambda1Def Word
forall a. Monoid a => a
mempty (State (Map Lambda1Def Word) () -> Map Lambda1Def Word)
-> (Block -> State (Map Lambda1Def Word) ())
-> Block
-> Map Lambda1Def Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> State (Map Lambda1Def Word) ()
lookForLambdas

-- | Associates each given 'Lambda1Def' to a new 'RefId', starting from the given
-- one. Also returns the first unused 'RefId'
createLambdaRefs :: RefId -> Set Lambda1Def -> ([(Lambda1Def, RefId)], RefId)
createLambdaRefs :: RefId -> Set Lambda1Def -> ([(Lambda1Def, RefId)], RefId)
createLambdaRefs nextRef :: RefId
nextRef =
  (Element (Set Lambda1Def)
 -> ([(Lambda1Def, RefId)], RefId)
 -> ([(Lambda1Def, RefId)], RefId))
-> ([(Lambda1Def, RefId)], RefId)
-> Set Lambda1Def
-> ([(Lambda1Def, RefId)], RefId)
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (\lm :: Element (Set Lambda1Def)
lm (lst :: [(Lambda1Def, RefId)]
lst, ref :: RefId
ref) -> ((Element (Set Lambda1Def)
Lambda1Def
lm, RefId
ref) (Lambda1Def, RefId)
-> [(Lambda1Def, RefId)] -> [(Lambda1Def, RefId)]
forall a. a -> [a] -> [a]
: [(Lambda1Def, RefId)]
lst, RefId
ref RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ 1)) ([], RefId
nextRef)

-- | Generates an 'Instruction' for each given tuple, to generate a lambda
-- (assigned to the respective variable) and leave it on the stack.
createAllLambdas :: [(Lambda1Def, RefId)] -> Block
createAllLambdas :: [(Lambda1Def, RefId)] -> Block
createAllLambdas = ((Lambda1Def, RefId) -> Instruction)
-> [(Lambda1Def, RefId)] -> Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (((Lambda1Def, RefId) -> Instruction)
 -> [(Lambda1Def, RefId)] -> Block)
-> ((Lambda1Def, RefId) -> Instruction)
-> [(Lambda1Def, RefId)]
-> Block
forall a b. (a -> b) -> a -> b
$ \(Lambda1Def {..}, lamRef :: RefId
lamRef) ->
  StackVars (arg : extra)
-> Var arg
-> Block
-> ret
-> Var (Lambda1Generic extra arg ret)
-> Instruction
forall (extra :: [*]) arg ret.
CreateLambda1CGeneric extra arg ret =>
StackVars (arg : extra)
-> Var arg
-> Block
-> ret
-> Var (Lambda1Generic extra arg ret)
-> Instruction
CreateLambda1 StackVars (arg : extra)
ldStack Var arg
ldArgVar Block
ldBody ret
ldRet (RefId -> Var (Lambda1Generic extra arg ret)
forall k (a :: k). RefId -> Var a
Var RefId
lamRef)

-- | Updates a 'Block', it looks for lambda "Calls" (defined and used in place)
-- to replace them with lambda "Exec", provided there is a known variable for an
-- already created lambda.
updateBlock :: Block -> Map String RefId -> Block
updateBlock :: Block -> Map String RefId -> Block
updateBlock blk :: Block
blk lambdaMap :: Map String RefId
lambdaMap = Block -> Block
updateBlock' Block
blk
  where
    updateBlock' :: Block -> Block
    updateBlock' :: Block -> Block
updateBlock' = (Instruction -> Instruction) -> Block -> Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Instruction -> Instruction) -> Block -> Block)
-> (Instruction -> Instruction) -> Block -> Block
forall a b. (a -> b) -> a -> b
$ \case
      -- Instructions not concerned, will be kept the same
      LiftIndigoState sis :: forall (inp :: [*]). SomeIndigoState inp
sis -> (forall (inp :: [*]). SomeIndigoState inp) -> Instruction
LiftIndigoState forall (inp :: [*]). SomeIndigoState inp
sis
      Comment txt :: Text
txt         -> Text -> Instruction
Comment Text
txt
      AssignVar vx :: Var x
vx ex :: Expr x
ex -> Var x -> Expr x -> Instruction
forall x. KnownValue x => Var x -> Expr x -> Instruction
AssignVar Var x
vx Expr x
ex
      SetVar vx :: Var x
vx ex :: Expr x
ex -> Var x -> Expr x -> Instruction
forall x. KnownValue x => Var x -> Expr x -> Instruction
SetVar Var x
vx Expr x
ex
      VarModification upd :: '[y, x] :-> '[x]
upd vx :: Var x
vx ey :: Expr y
ey -> ('[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
      SetField vSt :: Var store
vSt lName :: Label fname
lName ex :: Expr ftype
ex -> Var store -> 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 store
vSt Label fname
lName Expr ftype
ex

      -- Lambda instructions to check for possible replacement
      lc :: Instruction
lc@(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) ->
        case String -> Map String RefId -> Maybe RefId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
lName Map String RefId
lambdaMap of
          Nothing -> Instruction
lc
          Just ref :: RefId
ref -> LambdaKind st arg ret extra
-> Proxy ret
-> Expr arg
-> Var (Lambda1Generic extra arg ret)
-> RetVars ret
-> Instruction
forall st arg ret (extra :: [*]).
LambdaKind st arg ret extra
-> Proxy ret
-> Expr arg
-> Var (Lambda1Generic extra arg ret)
-> RetVars ret
-> Instruction
ExecLambda1 LambdaKind st arg ret extra
lKind Proxy ret
forall k (t :: k). Proxy t
Proxy Expr arg
ex (RefId -> Var (Lambda1Generic extra arg ret)
forall k (a :: k). RefId -> Var a
Var RefId
ref) RetVars ret
retVars

      -- Lambda instructions not concerned, nothing to replace here
      c :: Instruction
c@(CreateLambda1{}) -> Instruction
c
      e :: Instruction
e@(ExecLambda1{}) -> Instruction
e

      -- Instructions with deeper code blocks to replace as well
      Scope block :: Block
block ret :: ret
ret retVars :: RetVars ret
retVars ->
        Block -> ret -> RetVars ret -> Instruction
forall ret.
ScopeCodeGen ret =>
Block -> ret -> RetVars ret -> Instruction
Scope (Block -> Block
updateBlock' Block
block) 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 ->
        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 -> Block
updateBlock' Block
blockA) a
retA (Block -> Block
updateBlock' Block
blockB) 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 ->
        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 -> Block
updateBlock' Block
blockA) a
retA (Block -> Block
updateBlock' Block
blockB) 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 ->
        Expr (Either l r)
-> Var r
-> Block
-> a
-> Var l
-> 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 l r)
ex Var r
varR (Block -> Block
updateBlock' Block
blockA) a
retA Var l
varL (Block -> Block
updateBlock' Block
blockB) 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 ->
        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 -> Block
updateBlock' Block
blockA) a
retA (Block -> Block
updateBlock' Block
blockB) b
retB RetVars a
retVars

      Case grd :: Expr dt
grd blockClauses :: clauses
blockClauses retVars :: RetVars ret
retVars ->
        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 ((Block -> Block)
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
forall ret (dt :: [CaseClauseParam]).
(Block -> Block)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoSeqCaseClause ret) dt
updateClauses Block -> Block
updateBlock' 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 ->
        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 ((Block -> Block)
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
forall ret (dt :: [CaseClauseParam]).
(Block -> Block)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoSeqCaseClause ret) dt
updateClauses Block -> Block
updateBlock' clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses) RetVars ret
retVars
      EntryCaseSimple grd :: Expr dt
grd blockClauses :: clauses
blockClauses retVars :: RetVars ret
retVars ->
        Expr dt
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> 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 dt
grd ((Block -> Block)
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
forall ret (dt :: [CaseClauseParam]).
(Block -> Block)
-> Rec (IndigoSeqCaseClause ret) dt
-> Rec (IndigoSeqCaseClause ret) dt
updateClauses Block -> Block
updateBlock' clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses) RetVars ret
retVars

      While ex :: Expr Bool
ex block :: Block
block ->
        Expr Bool -> Block -> Instruction
While Expr Bool
ex (Block -> Block
updateBlock' Block
block)
      WhileLeft ex :: Expr (Either l r)
ex varL :: Var l
varL block :: Block
block varR :: Var r
varR ->
        Expr (Either l r) -> Var l -> Block -> Var r -> Instruction
forall l a.
(KnownValue l, KnownValue a) =>
Expr (Either l a) -> Var l -> Block -> Var a -> Instruction
WhileLeft Expr (Either l r)
ex Var l
varL (Block -> Block
updateBlock' Block
block) Var r
varR
      ForEach varIop :: Expr a
varIop ex :: Var (IterOpElHs a)
ex block :: Block
block ->
        Expr a -> Var (IterOpElHs a) -> Block -> Instruction
forall a.
(IterOpHs a, KnownValue (IterOpElHs a)) =>
Expr a -> Var (IterOpElHs a) -> Block -> Instruction
ForEach Expr a
varIop Var (IterOpElHs a)
ex (Block -> Block
updateBlock' Block
block)

      ContractName tx :: Text
tx block :: Block
block ->
        Text -> Block -> Instruction
ContractName Text
tx (Block -> Block
updateBlock' Block
block)
      DocGroup dg :: SubDoc -> di
dg block :: Block
block ->
        (SubDoc -> di) -> Block -> Instruction
forall di. DocItem di => (SubDoc -> di) -> Block -> Instruction
DocGroup SubDoc -> di
dg (Block -> Block
updateBlock' Block
block)
      ContractGeneral block :: Block
block ->
        Block -> Instruction
ContractGeneral (Block -> Block
updateBlock' Block
block)
      FinalizeParamCallingDoc varCp :: Var cp
varCp block :: Block
block param :: Expr cp
param ->
        Var cp -> Block -> Expr cp -> Instruction
forall cp.
(NiceParameterFull cp, RequireSumType cp) =>
Var cp -> Block -> Expr cp -> Instruction
FinalizeParamCallingDoc Var cp
varCp (Block -> Block
updateBlock' Block
block) Expr cp
param

      -- Instructions not concerned, will be kept the same
      TransferTokens ex :: Expr p
ex exm :: Expr Mutez
exm exc :: Expr (ContractRef p)
exc -> 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
      SetDelegate ex :: Expr (Maybe KeyHash)
ex -> HasSideEffects => Expr (Maybe KeyHash) -> Instruction
Expr (Maybe KeyHash) -> Instruction
SetDelegate Expr (Maybe KeyHash)
ex
      CreateContract varAddr :: Contract p s
varAddr ctrc :: Expr (Maybe KeyHash)
ctrc exk :: Expr Mutez
exk exm :: Expr s
exm exs :: Var Address
exs -> Contract p s
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> 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 p s
varAddr Expr (Maybe KeyHash)
ctrc Expr Mutez
exk Expr s
exm Var Address
exs
      SelfCalling proxy :: Proxy p
proxy varCR :: EntrypointRef mname
varCR ep :: Var (ContractRef (GetEntrypointArgCustom p mname))
ep -> 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
varCR Var (ContractRef (GetEntrypointArgCustom p mname))
ep
      ContractCalling varMcr :: Proxy cp
varMcr pCp :: epRef
pCp epRef :: Expr addr
epRef exAddr :: Var (Maybe (ContractRef epArg))
exAddr -> 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
varMcr epRef
pCp Expr addr
epRef Var (Maybe (ContractRef epArg))
exAddr

      Fail failure :: forall (inp :: [*]). SomeIndigoState inp
failure -> (forall (inp :: [*]). SomeIndigoState inp) -> Instruction
Fail forall (inp :: [*]). SomeIndigoState inp
failure
      FailOver failure :: forall (inp :: [*]). Expr a -> SomeIndigoState inp
failure ex :: Expr a
ex -> (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

-- Like 'collectLambdas', but uses 'State' to collect the 'Map' of all outer
-- lambdas encountered, including those used once.
lookForLambdas :: Block -> State (Map Lambda1Def Word) ()
lookForLambdas :: Block -> State (Map Lambda1Def Word) ()
lookForLambdas blk :: Block
blk = Block
-> (Element Block -> State (Map Lambda1Def Word) ())
-> State (Map Lambda1Def Word) ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ Block
blk Element Block -> State (Map Lambda1Def Word) ()
Instruction -> State (Map Lambda1Def Word) ()
match
  where
    -- pva701: it's crucial to have this function 'match' instead of code like
    -- @forM_ blk match $ \case@
    --        ... cases here ...
    -- because in the case of code above compilation of this function takes about 5-6 minutes
    -- it would be nice to figure out why (inspecting generated by GHC code)
    match :: Instruction -> State (Map Lambda1Def Word) ()
    match :: Instruction -> State (Map Lambda1Def Word) ()
match = \case
      -- Lambda instruction to collect
      LambdaCall1 lKind :: LambdaKind st arg ret extra
lKind ldName :: String
ldName _ex :: Expr arg
_ex ldArgVar :: Var arg
ldArgVar ldBody :: Block
ldBody ldRet :: ret
ldRet _retVars :: RetVars ret
_retVars -> do
        let ldStack :: StackVars (arg : extra)
ldStack = LambdaKind st arg ret extra -> Var arg -> StackVars (arg : extra)
forall st arg res (extra :: [*]).
LambdaKind st arg res extra -> Var arg -> StackVars (arg : extra)
initLambdaStackVars LambdaKind st arg ret extra
lKind Var arg
ldArgVar
        LambdaKind st arg ret extra
-> ((ScopeCodeGen ret, KnownValue arg, Typeable ret,
     CreateLambda1CGeneric extra arg ret) =>
    State (Map Lambda1Def Word) ())
-> State (Map Lambda1Def Word) ()
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) =>
  State (Map Lambda1Def Word) ())
 -> State (Map Lambda1Def Word) ())
-> ((ScopeCodeGen ret, KnownValue arg, Typeable ret,
     CreateLambda1CGeneric extra arg ret) =>
    State (Map Lambda1Def Word) ())
-> State (Map Lambda1Def Word) ()
forall a b. (a -> b) -> a -> b
$ Lambda1Def -> State (Map Lambda1Def Word) ()
addLambda (Lambda1Def -> State (Map Lambda1Def Word) ())
-> Lambda1Def -> State (Map Lambda1Def Word) ()
forall a b. (a -> b) -> a -> b
$ $WLambda1Def :: forall ret (extra :: [*]) arg.
(Typeable ret, CreateLambda1CGeneric extra arg ret) =>
ret
-> String
-> Block
-> Var arg
-> StackVars (arg : extra)
-> Lambda1Def
Lambda1Def {..}

      -- Instructions with deeper code block to look into
      Scope block :: Block
block _ _ -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      If _ blockA :: Block
blockA _ blockB :: Block
blockB _ _ ->
        Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockA State (Map Lambda1Def Word) ()
-> State (Map Lambda1Def Word) () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockB
      IfSome _ _ blockA :: Block
blockA _ blockB :: Block
blockB _ _ ->
        Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockA State (Map Lambda1Def Word) ()
-> State (Map Lambda1Def Word) () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockB
      IfRight _ _ blockA :: Block
blockA _ _ blockB :: Block
blockB _ _ ->
        Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockA State (Map Lambda1Def Word) ()
-> State (Map Lambda1Def Word) () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockB
      IfCons _ _ _ blockA :: Block
blockA _ blockB :: Block
blockB _ _ ->
        Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockA State (Map Lambda1Def Word) ()
-> State (Map Lambda1Def Word) () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
blockB
      Case _ blockClauses :: clauses
blockClauses _ ->
        (Block -> State (Map Lambda1Def Word) ())
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> State (Map Lambda1Def Word) ()
forall (m :: * -> *) ret (dt :: [CaseClauseParam]).
Monad m =>
(Block -> m ()) -> Rec (IndigoSeqCaseClause ret) dt -> m ()
mapMClauses Block -> State (Map Lambda1Def Word) ()
lookForLambdas clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses
      EntryCase _ _ blockClauses :: clauses
blockClauses _ ->
        (Block -> State (Map Lambda1Def Word) ())
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> State (Map Lambda1Def Word) ()
forall (m :: * -> *) ret (dt :: [CaseClauseParam]).
Monad m =>
(Block -> m ()) -> Rec (IndigoSeqCaseClause ret) dt -> m ()
mapMClauses Block -> State (Map Lambda1Def Word) ()
lookForLambdas clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses
      EntryCaseSimple _ blockClauses :: clauses
blockClauses _ ->
        (Block -> State (Map Lambda1Def Word) ())
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
-> State (Map Lambda1Def Word) ()
forall (m :: * -> *) ret (dt :: [CaseClauseParam]).
Monad m =>
(Block -> m ()) -> Rec (IndigoSeqCaseClause ret) dt -> m ()
mapMClauses Block -> State (Map Lambda1Def Word) ()
lookForLambdas clauses
Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt))
blockClauses
      While _ block :: Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      WhileLeft _ _ block :: Block
block _ -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      ForEach _ _ block :: Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      ContractName _ block :: Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      DocGroup _ block :: Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      ContractGeneral block :: Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
      FinalizeParamCallingDoc _ block :: Block
block _ -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block

      -- We skip two types of instructions:
      -- 1) Instructions without deeper code block
      -- 2) Unnamed lambdas creation/usage (like CreateLambda1, ExecLambda1, etc)

      -- Instructions without deeper code block
      LiftIndigoState {} -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Comment {}         -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      AssignVar {}       -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SetVar {}          -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      VarModification {} -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SetField {}        -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      TransferTokens {}  -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SetDelegate {}     -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      CreateContract {}  -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      SelfCalling {}     -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ContractCalling {} -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Fail {}            -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      FailOver {}        -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      -- Nothing to collect in the case of already unnamed lambdas creation/usage
      CreateLambda1 {}   -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ExecLambda1 {}     -> () -> State (Map Lambda1Def Word) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    addLambda :: Lambda1Def -> State (Map Lambda1Def Word) ()
    addLambda :: Lambda1Def -> State (Map Lambda1Def Word) ()
addLambda lDef :: Lambda1Def
lDef = (Map Lambda1Def Word -> Map Lambda1Def Word)
-> State (Map Lambda1Def Word) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Lambda1Def Word -> Map Lambda1Def Word)
 -> State (Map Lambda1Def Word) ())
-> (Map Lambda1Def Word -> Map Lambda1Def Word)
-> State (Map Lambda1Def Word) ()
forall a b. (a -> b) -> a -> b
$ (Word -> Word -> Word)
-> Lambda1Def -> Word -> Map Lambda1Def Word -> Map Lambda1Def Word
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) Lambda1Def
lDef 1

-- | Contains all the data necessary for the generation of a single-argument
-- lambda. Is compared only on the base of it's 'ldName'.
data Lambda1Def where
  Lambda1Def
    :: (Typeable ret, CreateLambda1CGeneric extra arg ret)
    => { ()
ldRet     :: ret
       , Lambda1Def -> String
ldName    :: String
       , Lambda1Def -> Block
ldBody    :: Block
       , ()
ldArgVar  :: Var arg
       , ()
ldStack   :: StackVars (arg : extra)
       } -> Lambda1Def

instance Eq Lambda1Def where
  == :: Lambda1Def -> Lambda1Def -> Bool
(==) l1 :: Lambda1Def
l1 l2 :: Lambda1Def
l2 = Lambda1Def -> String
ldName Lambda1Def
l1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Lambda1Def -> String
ldName Lambda1Def
l2

instance Ord Lambda1Def where
  <= :: Lambda1Def -> Lambda1Def -> Bool
(<=) l1 :: Lambda1Def
l1 l2 :: Lambda1Def
l2 = Lambda1Def -> String
ldName Lambda1Def
l1 String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= Lambda1Def -> String
ldName Lambda1Def
l2