module Indigo.Compilation.Lambda
( compileLambdas
) where
import Prelude
import Data.Map qualified as M
import Indigo.Backend as B
import Indigo.Common.Var
import Indigo.Compilation.Sequential
compileLambdas :: (Block, RefId) -> (Block, RefId)
compileLambdas :: (Block, RefId) -> (Block, RefId)
compileLambdas (Block
block, 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
([(Lambda1Def, RefId)]
lambdaRefDefs, 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
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
> Word
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
createLambdaRefs :: RefId -> Set Lambda1Def -> ([(Lambda1Def, RefId)], RefId)
createLambdaRefs :: RefId -> Set Lambda1Def -> ([(Lambda1Def, RefId)], RefId)
createLambdaRefs 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 (\Element (Set Lambda1Def)
lm ([(Lambda1Def, RefId)]
lst, 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
+ RefId
1)) ([], RefId
nextRef)
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 {ret
String
Block
Var arg
StackVars (arg : extra)
ldStack :: ()
ldArgVar :: ()
ldBody :: Lambda1Def -> Block
ldRet :: ()
ldStack :: StackVars (arg : extra)
ldArgVar :: Var arg
ldBody :: Block
ldName :: String
ldRet :: ret
ldName :: Lambda1Def -> String
..}, 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)
updateBlock :: Block -> Map String RefId -> Block
updateBlock :: Block -> Map String RefId -> Block
updateBlock Block
blk 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
LiftIndigoState forall (inp :: [*]). SomeIndigoState inp
sis -> (forall (inp :: [*]). SomeIndigoState inp) -> Instruction
LiftIndigoState forall (inp :: [*]). SomeIndigoState inp
sis
Comment Text
txt -> Text -> Instruction
Comment Text
txt
AssignVar Var x
vx 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 Var x
vx 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 '[y, x] :-> '[x]
upd Var x
vx Expr y
ey -> ('[y, x] :-> '[x]) -> Var x -> Expr y -> Instruction
forall x y.
(IsObject x, KnownValue y) =>
('[y, x] :-> '[x]) -> Var x -> Expr y -> Instruction
VarModification '[y, x] :-> '[x]
upd Var x
vx Expr y
ey
SetField Var store
vSt Label fname
lName 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
lc :: Instruction
lc@(LambdaCall1 LambdaKind st arg ret extra
lKind String
lName Expr arg
ex Var arg
_var Block
_block ret
_ret 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
Maybe RefId
Nothing -> Instruction
lc
Just 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
c :: Instruction
c@(CreateLambda1{}) -> Instruction
c
e :: Instruction
e@(ExecLambda1{}) -> Instruction
e
Scope Block
block ret
ret 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 Expr Bool
ex Block
blockA a
retA Block
blockB b
retB RetVars a
retVars ->
Expr Bool -> Block -> a -> Block -> b -> RetVars a -> Instruction
forall a b.
IfConstraint a b =>
Expr Bool -> Block -> a -> Block -> b -> 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 Expr (Maybe x)
ex Var x
varX Block
blockA a
retA Block
blockB b
retB 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 Expr (Either l r)
ex Var r
varR Block
blockA a
retA Var l
varL Block
blockB b
retB RetVars a
retVars ->
Expr (Either l r)
-> Var r
-> Block
-> a
-> Var l
-> Block
-> b
-> RetVars a
-> Instruction
forall a b r l.
(IfConstraint a b, KnownValue r, KnownValue l) =>
Expr (Either l r)
-> Var r
-> Block
-> a
-> Var l
-> 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 Expr (List x)
ex Var x
varX Var (List x)
varLX Block
blockA a
retA Block
blockB b
retB 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 Expr dt
grd clauses
blockClauses 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 entryPointKind
proxy Expr dt
grd clauses
blockClauses RetVars ret
retVars ->
Proxy entryPointKind
-> Expr dt
-> Rec (IndigoSeqCaseClause ret) (GCaseClauses (Rep dt) '[])
-> RetVars ret
-> Instruction
forall dt ret clauses entryPointKind.
(CaseCommon dt ret clauses,
DocumentEntrypoints entryPointKind dt) =>
Proxy entryPointKind
-> Expr dt -> clauses -> 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 Expr dt
grd clauses
blockClauses 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 Expr Bool
ex Block
block ->
Expr Bool -> Block -> Instruction
While Expr Bool
ex (Block -> Block
updateBlock' Block
block)
WhileLeft Expr (Either l r)
ex Var l
varL Block
block Var r
varR ->
Expr (Either l r) -> Var l -> Block -> Var r -> Instruction
forall l r.
(KnownValue l, KnownValue r) =>
Expr (Either l r) -> Var l -> Block -> Var r -> Instruction
WhileLeft Expr (Either l r)
ex Var l
varL (Block -> Block
updateBlock' Block
block) Var r
varR
ForEach Expr a
varIop Var (IterOpElHs a)
ex 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 Text
tx Block
block ->
Text -> Block -> Instruction
ContractName Text
tx (Block -> Block
updateBlock' Block
block)
DocGroup SubDoc -> di
dg 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 -> Instruction
ContractGeneral (Block -> Block
updateBlock' Block
block)
FinalizeParamCallingDoc Var cp
varCp Block
block 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
TransferTokens Expr p
ex Expr Mutez
exm Expr (ContractRef p)
exc -> Expr p -> Expr Mutez -> Expr (ContractRef p) -> Instruction
forall p.
(NiceParameter p, HasSideEffects, IsNotInView) =>
Expr p -> Expr Mutez -> Expr (ContractRef p) -> Instruction
TransferTokens Expr p
ex Expr Mutez
exm Expr (ContractRef p)
exc
SetDelegate Expr (Maybe KeyHash)
ex -> (HasSideEffects, IsNotInView) =>
Expr (Maybe KeyHash) -> Instruction
Expr (Maybe KeyHash) -> Instruction
SetDelegate Expr (Maybe KeyHash)
ex
CreateContract Contract p s vd
varAddr Expr (Maybe KeyHash)
ctrc Expr Mutez
exk Expr s
exm Var Address
exs -> Contract p s vd
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> Instruction
forall s p vd.
(HasSideEffects, NiceStorage s, NiceParameterFull p,
NiceViewsDescriptor vd, Typeable vd, IsNotInView) =>
Contract p s vd
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> Instruction
CreateContract Contract p s vd
varAddr Expr (Maybe KeyHash)
ctrc Expr Mutez
exk Expr s
exm Var Address
exs
SelfCalling Proxy p
proxy EntrypointRef mname
varCR Var (ContractRef (GetEntrypointArgCustom p mname))
ep -> Proxy p
-> EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> Instruction
forall p (mname :: Maybe Symbol).
(NiceParameterFull p, KnownValue (GetEntrypointArgCustom p mname),
IsoValue (ContractRef (GetEntrypointArgCustom p mname)),
IsNotInView) =>
Proxy p
-> EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> Instruction
SelfCalling Proxy p
proxy EntrypointRef mname
varCR Var (ContractRef (GetEntrypointArgCustom p mname))
ep
ContractCalling Proxy (cp, vd)
varMcr epRef
pCp Expr addr
epRef Var (Maybe (ContractRef epArg))
exAddr -> Proxy (cp, vd)
-> epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> Instruction
forall cp epRef epArg vd addr.
(HasEntrypointArg cp epRef epArg, ToTAddress cp vd addr,
ToT addr ~ ToT Address, KnownValue epArg,
IsoValue (ContractRef epArg)) =>
Proxy (cp, vd)
-> epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> Instruction
ContractCalling Proxy (cp, vd)
varMcr epRef
pCp Expr addr
epRef Var (Maybe (ContractRef epArg))
exAddr
Emit FieldAnn
tag Expr a
ex -> FieldAnn -> Expr a -> Instruction
forall a.
(HasSideEffects, NicePackedValue a, HasAnnotation a) =>
FieldAnn -> Expr a -> Instruction
Emit FieldAnn
tag Expr a
ex
Fail forall (inp :: [*]). SomeIndigoState inp
failure -> (forall (inp :: [*]). SomeIndigoState inp) -> Instruction
Fail forall (inp :: [*]). SomeIndigoState inp
failure
FailOver forall (inp :: [*]). Expr a -> SomeIndigoState inp
failure 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
lookForLambdas :: Block -> State (Map Lambda1Def Word) ()
lookForLambdas :: Block -> State (Map Lambda1Def Word) ()
lookForLambdas 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
match :: Instruction -> State (Map Lambda1Def Word) ()
match :: Instruction -> State (Map Lambda1Def Word) ()
match = \case
LambdaCall1 LambdaKind st arg ret extra
lKind String
ldName Expr arg
_ex Var arg
ldArgVar Block
ldBody ret
ldRet 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
$ Lambda1Def :: forall ret (extra :: [*]) arg.
(Typeable ret, CreateLambda1CGeneric extra arg ret) =>
ret
-> String
-> Block
-> Var arg
-> StackVars (arg : extra)
-> Lambda1Def
Lambda1Def {ret
String
Block
Var arg
StackVars (arg : extra)
ldStack :: StackVars (arg : extra)
ldRet :: ret
ldBody :: Block
ldArgVar :: Var arg
ldName :: String
ldStack :: StackVars (arg : extra)
ldArgVar :: Var arg
ldBody :: Block
ldRet :: ret
ldName :: String
..}
Scope Block
block ret
_ RetVars ret
_ -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
If Expr Bool
_ Block
blockA a
_ Block
blockB b
_ RetVars a
_ ->
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 Expr (Maybe x)
_ Var x
_ Block
blockA a
_ Block
blockB b
_ RetVars a
_ ->
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 Expr (Either l r)
_ Var r
_ Block
blockA a
_ Var l
_ Block
blockB b
_ RetVars a
_ ->
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 Expr (List x)
_ Var x
_ Var (List x)
_ Block
blockA a
_ Block
blockB b
_ RetVars a
_ ->
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 Expr dt
_ clauses
blockClauses RetVars ret
_ ->
(Block -> State (Map Lambda1Def Word) ())
-> Rec (IndigoSeqCaseClause ret) (CaseClauses 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) (CaseClauses dt)
blockClauses
EntryCase Proxy entryPointKind
_ Expr dt
_ clauses
blockClauses RetVars ret
_ ->
(Block -> State (Map Lambda1Def Word) ())
-> Rec (IndigoSeqCaseClause ret) (CaseClauses 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) (CaseClauses dt)
blockClauses
EntryCaseSimple Expr dt
_ clauses
blockClauses RetVars ret
_ ->
(Block -> State (Map Lambda1Def Word) ())
-> Rec (IndigoSeqCaseClause ret) (CaseClauses 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) (CaseClauses dt)
blockClauses
While Expr Bool
_ Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
WhileLeft Expr (Either l r)
_ Var l
_ Block
block Var r
_ -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
ForEach Expr a
_ Var (IterOpElHs a)
_ Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
ContractName Text
_ Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
DocGroup SubDoc -> di
_ Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
ContractGeneral Block
block -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
block
FinalizeParamCallingDoc Var cp
_ Block
block Expr cp
_ -> Block -> State (Map Lambda1Def Word) ()
lookForLambdas Block
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 ()
Emit {} -> () -> 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 ()
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 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 Word
1
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
(==) Lambda1Def
l1 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
(<=) Lambda1Def
l1 Lambda1Def
l2 = Lambda1Def -> String
ldName Lambda1Def
l1 String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= Lambda1Def -> String
ldName Lambda1Def
l2