module Indigo.Compilation.Lambda
( CompiledLambda (..)
, Lambda1Def (..)
, collectLambdas
) where
import Prelude
import qualified Data.Map as M
import Indigo.Backend as B
import Indigo.Frontend.Program (IndigoM(..), interpretProgram)
import Indigo.Frontend.Statement
import Indigo.Internal.Object
import Indigo.Internal.SIS
import Indigo.Internal.State hiding ((>>))
import Indigo.Lorentz
data CompiledLambda where
CompiledLambda
:: (Typeable arg, Typeable res, Typeable extra)
=> { ()
_clProxyRes :: Proxy res
, CompiledLambda -> String
_clName :: String
, ()
_clVarLam :: Var (B.Lambda1Generic extra arg res)
} -> CompiledLambda
data Lambda1Def where
LambdaPure1Def
:: (Typeable res, CreateLambdaPure1C arg res)
=> { ()
_ldProxy :: Proxy (_stUnit, arg, res)
, Lambda1Def -> String
_ldName :: String
, ()
_ldBody :: Var arg -> IndigoM res
} -> Lambda1Def
Lambda1Def
:: (Typeable res, CreateLambda1C st arg res)
=> { _ldProxy :: Proxy (st, arg, res)
, _ldName :: String
, _ldBody :: Var arg -> IndigoM res
} -> Lambda1Def
LambdaEff1Def
:: (Typeable res, CreateLambdaEff1C st arg res)
=> { _ldProxy :: Proxy (st, arg, res)
, _ldName :: String
, _ldBody :: Var arg -> IndigoM res
} -> 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
leakedVar :: KnownValue a => Var a
leakedVar :: Var a
leakedVar = RefId -> Var a
forall a (f :: Symbol -> *).
KnownValue a =>
RefId -> IndigoObjectF f a
Cell (RefId -> Var a) -> RefId -> Var a
forall a b. (a -> b) -> a -> b
$
Text -> RefId
forall a. HasCallStack => Text -> a
error "In a scope of function you are using a variable from an outer scope. Closures are not supported yet."
leakedScopeVariableAllocator :: KnownValue a => MetaData _inp -> (Var a, MetaData (a & _inp))
leakedScopeVariableAllocator :: MetaData _inp -> (Var a, MetaData (a & _inp))
leakedScopeVariableAllocator (MetaData stk :: StackVars _inp
stk cnt :: RefId
cnt) =
let v :: Var a
v = Var a
forall a. KnownValue a => Var a
leakedVar
in (Var a
v, StackVars (a & _inp) -> RefId -> MetaData (a & _inp)
forall (stk :: [*]). StackVars stk -> RefId -> MetaData stk
MetaData (RefId -> StkEl a
forall a. KnownValue a => RefId -> StkEl a
Ref RefId
cnt StkEl a -> StackVars _inp -> StackVars (a & _inp)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StackVars _inp
stk) (RefId
cnt RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ 1))
allocateVarsLeaked :: forall a . ReturnableValue a => RetVars a
allocateVarsLeaked :: RetVars a
allocateVarsLeaked = (RetVars a,
MetaData (RetOutStack' (ClassifyReturnValue a) a ++ '[]))
-> RetVars a
forall a b. (a, b) -> a
fst ((forall (inpt :: [*]) x.
KnownValue x =>
MetaData inpt -> (Var x, MetaData (x & inpt)))
-> MetaData '[]
-> (RetVars a,
MetaData (RetOutStack' (ClassifyReturnValue a) a ++ '[]))
forall ret (inp :: [*]).
ReturnableValue ret =>
(forall (inpt :: [*]) x.
KnownValue x =>
MetaData inpt -> (Var x, MetaData (x & inpt)))
-> MetaData inp -> (RetVars ret, MetaData (RetOutStack ret ++ inp))
allocateVars @a forall (inpt :: [*]) x.
KnownValue x =>
MetaData inpt -> (Var x, MetaData (x & inpt))
forall a (_inp :: [*]).
KnownValue a =>
MetaData _inp -> (Var a, MetaData (a & _inp))
leakedScopeVariableAllocator MetaData '[]
emptyMetadata)
allocateVarsLeakedM :: forall a m . (Monad m, ReturnableValue a) => m a -> m (RetVars a)
allocateVarsLeakedM :: m a -> m (RetVars a)
allocateVarsLeakedM ma :: m a
ma = ReturnableValue a => RetVars a
forall a. ReturnableValue a => RetVars a
allocateVarsLeaked @a RetVars a -> m a -> m (RetVars a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m a
ma
collectLambdas :: forall a . IndigoM a -> Set Lambda1Def
collectLambdas :: IndigoM a -> Set Lambda1Def
collectLambdas indigoM :: IndigoM a
indigoM =
Map Lambda1Def Word -> Set Lambda1Def
forall k a. Map k a -> Set k
M.keysSet (Map Lambda1Def Word -> Set Lambda1Def)
-> Map Lambda1Def Word -> Set Lambda1Def
forall a b. (a -> b) -> a -> b
$ (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)
-> Map Lambda1Def Word -> Map Lambda1Def Word
forall a b. (a -> b) -> a -> b
$ Map Lambda1Def Word
-> State (Map Lambda1Def Word) a -> Map Lambda1Def Word
forall s a. s -> State s a -> s
executingState Map Lambda1Def Word
forall a. Monoid a => a
mempty (IndigoM a -> State (Map Lambda1Def Word) a
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM a
indigoM)
where
lookForLambdas :: IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas :: IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (IndigoM program :: Program (StatementF IndigoM) x
program) = (forall x.
StatementF IndigoM x -> StateT (Map Lambda1Def Word) Identity x)
-> Program (StatementF IndigoM) x -> State (Map Lambda1Def Word) x
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
(forall x. instr x -> m x) -> Program instr a -> m a
interpretProgram forall x.
StatementF IndigoM x -> StateT (Map Lambda1Def Word) Identity x
inspectLambda Program (StatementF IndigoM) x
program
inspectLambda :: StatementF IndigoM x -> State (Map Lambda1Def Word) x
inspectLambda :: StatementF IndigoM x -> State (Map Lambda1Def Word) x
inspectLambda (LambdaPure1Call name :: String
name (Var arg -> IndigoM res
body :: (Var arg -> IndigoM res)) _) =
ReturnableValue res => RetVars res
forall a. ReturnableValue a => RetVars a
allocateVarsLeaked @res x
-> StateT (Map Lambda1Def Word) Identity ()
-> State (Map Lambda1Def Word) x
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Map Lambda1Def Word -> Map Lambda1Def Word)
-> StateT (Map Lambda1Def Word) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Lambda1Def -> Map Lambda1Def Word -> Map Lambda1Def Word
addLambda (Proxy ((), arg, res)
-> String -> (Var arg -> IndigoM res) -> Lambda1Def
forall res arg _stUnit.
(Typeable res, CreateLambdaPure1C arg res) =>
Proxy (_stUnit, arg, res)
-> String -> (Var arg -> IndigoM res) -> Lambda1Def
LambdaPure1Def (Proxy ((), arg, res)
forall k (t :: k). Proxy t
Proxy @((), arg, res)) String
name Var arg -> IndigoM res
body))
inspectLambda (Lambda1Call (Proxy st
_ :: Proxy st) name :: String
name (Var arg -> IndigoM res
body :: (Var arg -> IndigoM res)) _) =
ReturnableValue res => RetVars res
forall a. ReturnableValue a => RetVars a
allocateVarsLeaked @res x
-> StateT (Map Lambda1Def Word) Identity ()
-> State (Map Lambda1Def Word) x
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Map Lambda1Def Word -> Map Lambda1Def Word)
-> StateT (Map Lambda1Def Word) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Lambda1Def -> Map Lambda1Def Word -> Map Lambda1Def Word
addLambda (Proxy (st, arg, res)
-> String -> (Var arg -> IndigoM res) -> Lambda1Def
forall res st arg.
(Typeable res, CreateLambda1C st arg res) =>
Proxy (st, arg, res)
-> String -> (Var arg -> IndigoM res) -> Lambda1Def
Lambda1Def (Proxy (st, arg, res)
forall k (t :: k). Proxy t
Proxy @(st, arg, res)) String
name Var arg -> IndigoM res
body))
inspectLambda (LambdaEff1Call (Proxy st
_ :: Proxy st) name :: String
name (Var arg -> IndigoM res
body :: (Var arg -> IndigoM res)) _) =
ReturnableValue res => RetVars res
forall a. ReturnableValue a => RetVars a
allocateVarsLeaked @res x
-> StateT (Map Lambda1Def Word) Identity ()
-> State (Map Lambda1Def Word) x
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Map Lambda1Def Word -> Map Lambda1Def Word)
-> StateT (Map Lambda1Def Word) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Lambda1Def -> Map Lambda1Def Word -> Map Lambda1Def Word
addLambda (Proxy (st, arg, res)
-> String -> (Var arg -> IndigoM res) -> Lambda1Def
forall res st arg.
(Typeable res, CreateLambdaEff1C st arg res) =>
Proxy (st, arg, res)
-> String -> (Var arg -> IndigoM res) -> Lambda1Def
LambdaEff1Def (Proxy (st, arg, res)
forall k (t :: k). Proxy t
Proxy @(st, arg, res)) String
name Var arg -> IndigoM res
body))
inspectLambda (Scope cd :: IndigoM a
cd) = StateT (Map Lambda1Def Word) Identity a
-> State (Map Lambda1Def Word) x
forall a (m :: * -> *).
(Monad m, ReturnableValue a) =>
m a -> m (RetVars a)
allocateVarsLeakedM (StateT (Map Lambda1Def Word) Identity a
-> State (Map Lambda1Def Word) x)
-> StateT (Map Lambda1Def Word) Identity a
-> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ IndigoM a -> StateT (Map Lambda1Def Word) Identity a
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM a
cd
inspectLambda (If _ tb :: IndigoM a
tb fb :: IndigoM b
fb) = StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a (m :: * -> *).
(Monad m, ReturnableValue a) =>
m a -> m (RetVars a)
allocateVarsLeakedM (StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x)
-> StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ IndigoM a -> State (Map Lambda1Def Word) a
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM a
tb State (Map Lambda1Def Word) a
-> StateT (Map Lambda1Def Word) Identity b
-> StateT (Map Lambda1Def Word) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndigoM b -> StateT (Map Lambda1Def Word) Identity b
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM b
fb
inspectLambda (IfSome _ tb :: Var x -> IndigoM a
tb fb :: IndigoM b
fb) = StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a (m :: * -> *).
(Monad m, ReturnableValue a) =>
m a -> m (RetVars a)
allocateVarsLeakedM (StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x)
-> StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ IndigoM a -> State (Map Lambda1Def Word) a
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var x -> IndigoM a
tb Var x
forall a. KnownValue a => Var a
leakedVar) State (Map Lambda1Def Word) a
-> StateT (Map Lambda1Def Word) Identity b
-> StateT (Map Lambda1Def Word) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndigoM b -> StateT (Map Lambda1Def Word) Identity b
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM b
fb
inspectLambda (IfRight _ rb :: Var x -> IndigoM a
rb lb :: Var y -> IndigoM b
lb) = StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a (m :: * -> *).
(Monad m, ReturnableValue a) =>
m a -> m (RetVars a)
allocateVarsLeakedM (StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x)
-> StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ IndigoM a -> State (Map Lambda1Def Word) a
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var x -> IndigoM a
rb Var x
forall a. KnownValue a => Var a
leakedVar) State (Map Lambda1Def Word) a
-> StateT (Map Lambda1Def Word) Identity b
-> StateT (Map Lambda1Def Word) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndigoM b -> StateT (Map Lambda1Def Word) Identity b
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var y -> IndigoM b
lb Var y
forall a. KnownValue a => Var a
leakedVar)
inspectLambda (IfCons _ tb :: Var x -> Var (List x) -> IndigoM a
tb fb :: IndigoM b
fb) = StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a (m :: * -> *).
(Monad m, ReturnableValue a) =>
m a -> m (RetVars a)
allocateVarsLeakedM (StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x)
-> StateT (Map Lambda1Def Word) Identity b
-> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ IndigoM a -> State (Map Lambda1Def Word) a
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var x -> Var (List x) -> IndigoM a
tb Var x
forall a. KnownValue a => Var a
leakedVar Var (List x)
forall a. KnownValue a => Var a
leakedVar) State (Map Lambda1Def Word) a
-> StateT (Map Lambda1Def Word) Identity b
-> StateT (Map Lambda1Def Word) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IndigoM b -> StateT (Map Lambda1Def Word) Identity b
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM b
fb
inspectLambda (Case _ clauses :: clauses
clauses) = Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
-> State (Map Lambda1Def Word) (RetVars ret)
forall ret (cs :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) cs
-> State (Map Lambda1Def Word) (RetVars ret)
rmapClauses clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
clauses
inspectLambda (EntryCase _ _ clauses :: clauses
clauses) = Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
-> State (Map Lambda1Def Word) (RetVars ret)
forall ret (cs :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) cs
-> State (Map Lambda1Def Word) (RetVars ret)
rmapClauses clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep dt))
clauses
inspectLambda (EntryCaseSimple _ clauses :: clauses
clauses) = Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep cp))
-> State (Map Lambda1Def Word) (RetVars ret)
forall ret (cs :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) cs
-> State (Map Lambda1Def Word) (RetVars ret)
rmapClauses clauses
Rec (IndigoMCaseClauseL IndigoM ret) (GCaseClauses (Rep cp))
clauses
inspectLambda (While _ body :: IndigoM ()
body) = IndigoM () -> StateT (Map Lambda1Def Word) Identity ()
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM ()
body
inspectLambda (WhileLeft _ body :: Var y -> IndigoM ()
body) = IndigoM () -> StateT (Map Lambda1Def Word) Identity ()
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var y -> IndigoM ()
body Var y
forall a. KnownValue a => Var a
leakedVar) StateT (Map Lambda1Def Word) Identity ()
-> StateT (Map Lambda1Def Word) Identity (Var x)
-> StateT (Map Lambda1Def Word) Identity (Var x)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Var x -> StateT (Map Lambda1Def Word) Identity (Var x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var x
forall a. KnownValue a => Var a
leakedVar
inspectLambda (ForEach _ body :: Var (IterOpElHs a) -> IndigoM ()
body) = IndigoM () -> State (Map Lambda1Def Word) x
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (IndigoM () -> State (Map Lambda1Def Word) x)
-> IndigoM () -> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ Var (IterOpElHs a) -> IndigoM ()
body Var (IterOpElHs a)
forall a. KnownValue a => Var a
leakedVar
inspectLambda (ContractName _ contr :: IndigoM ()
contr) = IndigoM () -> StateT (Map Lambda1Def Word) Identity ()
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM ()
contr
inspectLambda (DocGroup _ ii :: IndigoM ()
ii) = IndigoM () -> StateT (Map Lambda1Def Word) Identity ()
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM ()
ii
inspectLambda (ContractGeneral contr :: IndigoM ()
contr) = IndigoM () -> StateT (Map Lambda1Def Word) Identity ()
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas IndigoM ()
contr
inspectLambda (FinalizeParamCallingDoc entrypoint :: Var cp -> IndigoM x
entrypoint _) = IndigoM x -> State (Map Lambda1Def Word) x
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var cp -> IndigoM x
entrypoint Var cp
forall a. KnownValue a => Var a
leakedVar)
inspectLambda (LiftIndigoState cd :: forall (inp :: [*]). SomeIndigoState inp x
cd) = x -> State (Map Lambda1Def Word) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> State (Map Lambda1Def Word) x)
-> x -> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ SomeIndigoState '[] x
-> MetaData '[]
-> (forall (out :: [*]). GenCode '[] out x -> x)
-> x
forall (inp :: [*]) a r.
SomeIndigoState inp a
-> MetaData inp
-> (forall (out :: [*]). GenCode inp out a -> r)
-> r
runSIS SomeIndigoState '[] x
forall (inp :: [*]). SomeIndigoState inp x
cd MetaData '[]
emptyMetadata forall (out :: [*]). GenCode '[] out x -> x
forall (inp :: [*]) (out :: [*]) a. GenCode inp out a -> a
gcOut
inspectLambda (NewVar _) = Var x -> StateT (Map Lambda1Def Word) Identity (Var x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var x
forall a. KnownValue a => Var a
leakedVar
inspectLambda (SetVar _ _) = () -> StateT (Map Lambda1Def Word) Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inspectLambda (SetField {}) = () -> StateT (Map Lambda1Def Word) Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inspectLambda (VarModification {}) = () -> StateT (Map Lambda1Def Word) Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inspectLambda (TransferTokens {}) = () -> StateT (Map Lambda1Def Word) Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inspectLambda (SetDelegate _) = () -> StateT (Map Lambda1Def Word) Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inspectLambda (CreateContract{}) = Var Address -> StateT (Map Lambda1Def Word) Identity (Var Address)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var Address
forall a. KnownValue a => Var a
leakedVar
inspectLambda (ContractCalling{}) = Var (Maybe (ContractRef epArg))
-> StateT
(Map Lambda1Def Word) Identity (Var (Maybe (ContractRef epArg)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var (Maybe (ContractRef epArg))
forall a. KnownValue a => Var a
leakedVar
inspectLambda (FailWith ex :: Expr a
ex) = x -> State (Map Lambda1Def Word) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> State (Map Lambda1Def Word) x)
-> x -> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ GenCode '[] Any x -> x
forall (inp :: [*]) (out :: [*]) a. GenCode inp out a -> a
gcOut (GenCode '[] Any x -> x) -> GenCode '[] Any x -> x
forall a b. (a -> b) -> a -> b
$ IndigoState '[] Any x -> MetaData '[] -> GenCode '[] Any x
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (Expr a -> IndigoState '[] Any x
forall a (s :: [*]) (t :: [*]) r.
KnownValue a =>
Expr a -> IndigoState s t r
B.failWith Expr a
ex) MetaData '[]
emptyMetadata
inspectLambda (Assert _ _) = () -> StateT (Map Lambda1Def Word) Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inspectLambda (FailCustom tag :: Label tag
tag ex :: Expr err
ex) = x -> State (Map Lambda1Def Word) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> State (Map Lambda1Def Word) x)
-> x -> State (Map Lambda1Def Word) x
forall a b. (a -> b) -> a -> b
$ GenCode '[] Any x -> x
forall (inp :: [*]) (out :: [*]) a. GenCode inp out a -> a
gcOut (GenCode '[] Any x -> x) -> GenCode '[] Any x -> x
forall a b. (a -> b) -> a -> b
$ IndigoState '[] Any x -> MetaData '[] -> GenCode '[] Any x
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (Label tag -> Expr err -> IndigoState '[] Any x
forall (tag :: Symbol) err (s :: [*]) (t :: [*]) r.
(err ~ ErrorArg tag, CustomErrorHasDoc tag, NiceConstant err) =>
Label tag -> Expr err -> IndigoState s t r
B.failCustom Label tag
tag Expr err
ex) MetaData '[]
emptyMetadata
rmapClauses:: forall ret cs . ReturnableValue ret
=> Rec (IndigoMCaseClauseL IndigoM ret) cs
-> State (Map Lambda1Def Word) (RetVars ret)
rmapClauses :: Rec (IndigoMCaseClauseL IndigoM ret) cs
-> State (Map Lambda1Def Word) (RetVars ret)
rmapClauses RNil = RetVars ret -> State (Map Lambda1Def Word) (RetVars ret)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReturnableValue ret => RetVars ret
forall a. ReturnableValue a => RetVars a
allocateVarsLeaked @ret)
rmapClauses ((OneFieldIndigoMCaseClauseL _ clause :: Var x -> IndigoM retBr
clause) :& rs :: Rec (IndigoMCaseClauseL IndigoM ret) rs
rs) =
IndigoM retBr -> State (Map Lambda1Def Word) retBr
forall x. IndigoM x -> State (Map Lambda1Def Word) x
lookForLambdas (Var x -> IndigoM retBr
clause Var x
forall a. KnownValue a => Var a
leakedVar) State (Map Lambda1Def Word) retBr
-> State (Map Lambda1Def Word) (RetVars ret)
-> State (Map Lambda1Def Word) (RetVars ret)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rec (IndigoMCaseClauseL IndigoM ret) rs
-> State (Map Lambda1Def Word) (RetVars ret)
forall ret (cs :: [CaseClauseParam]).
ReturnableValue ret =>
Rec (IndigoMCaseClauseL IndigoM ret) cs
-> State (Map Lambda1Def Word) (RetVars ret)
rmapClauses Rec (IndigoMCaseClauseL IndigoM ret) rs
rs
addLambda :: Lambda1Def -> Map Lambda1Def Word -> Map Lambda1Def Word
addLambda :: Lambda1Def -> Map Lambda1Def Word -> Map Lambda1Def Word
addLambda =
(Maybe Word -> Maybe Word)
-> Lambda1Def -> Map Lambda1Def Word -> Map Lambda1Def Word
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\case
Nothing -> Word -> Maybe Word
forall a. a -> Maybe a
Just 1
Just x :: Word
x -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1)
)