module Indigo.Backend.Lambda
( LambdaKind (..)
, withLambdaKind
, executeLambda1
, initLambdaStackVars
, CreateLambdaPure1C
, ExecuteLambdaPure1C
, CreateLambda1C
, ExecuteLambda1C
, CreateLambdaEff1C
, ExecuteLambdaEff1C
, CreateLambda1CGeneric
, createLambda1Generic
, Lambda1Generic
) where
import Data.Constraint (Dict(..))
import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Backend.Var
import Indigo.Internal hiding ((+), (<>))
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import Lorentz.Zip (ZipInstr, ZippedStack)
import Util.Type (type (++), KnownList, listOfTypesConcatAssociativityAxiom)
data LambdaKind st arg res extra where
PureLambda ::
(ExecuteLambdaPure1C arg res, CreateLambda1CGeneric '[] arg res, Typeable res)
=> LambdaKind st arg res '[]
StorageLambda ::
(ExecuteLambda1C st arg res, CreateLambda1CGeneric '[st] arg res, Typeable res)
=> Proxy st
-> LambdaKind st arg res '[st]
EffLambda
:: (ExecuteLambdaEff1C st arg res, CreateLambda1CGeneric '[st, Ops] arg res, Typeable res)
=> Proxy st
-> LambdaKind st arg res '[st, Ops]
withLambdaKind
:: LambdaKind st arg res extra
-> ((ScopeCodeGen res, KnownValue arg, Typeable res, CreateLambda1CGeneric extra arg res) => r)
-> r
withLambdaKind :: LambdaKind st arg res extra
-> ((ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r)
-> r
withLambdaKind PureLambda r :: (ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r
r = r
(ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r
r
withLambdaKind (StorageLambda _) r :: (ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r
r = r
(ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r
r
withLambdaKind (EffLambda _) r :: (ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r
r = r
(ScopeCodeGen res, KnownValue arg, Typeable res,
CreateLambda1CGeneric extra arg res) =>
r
r
executeLambda1
:: forall res st arg extra inp .
LambdaKind st arg res extra -> RefId -> RetVars res -> LambdaExecutor extra arg res inp
executeLambda1 :: LambdaKind st arg res extra
-> RefId -> RetVars res -> LambdaExecutor extra arg res inp
executeLambda1 PureLambda _ retVars :: RetVars res
retVars = RetVars res -> LambdaExecutor '[] arg res inp
forall res arg (inp :: [*]).
ExecuteLambdaPure1C arg res =>
RetVars res -> LambdaExecutor '[] arg res inp
executeLambdaPure1 @res RetVars res
retVars
executeLambda1 (StorageLambda _) refId :: RefId
refId retVars :: RetVars res
retVars = RefId -> RetVars res -> LambdaExecutor '[st] arg res inp
forall res st arg (inp :: [*]).
ExecuteLambda1C st arg res =>
RefId -> RetVars res -> LambdaExecutor '[st] arg res inp
executeLambdaSt1 @res RefId
refId RetVars res
retVars
executeLambda1 (EffLambda _) refId :: RefId
refId retVars :: RetVars res
retVars = RefId -> RetVars res -> LambdaExecutor '[st, Ops] arg res inp
forall res st arg (inp :: [*]).
ExecuteLambdaEff1C st arg res =>
RefId -> RetVars res -> LambdaExecutor '[st, Ops] arg res inp
executeLambdaEff1 @res RefId
refId RetVars res
retVars
initLambdaStackVars :: LambdaKind st arg res extra -> Var arg -> StackVars (arg & extra)
initLambdaStackVars :: LambdaKind st arg res extra -> Var arg -> StackVars (arg & extra)
initLambdaStackVars PureLambda = Var arg -> StackVars (arg & extra)
forall arg. KnownValue arg => Var arg -> StackVars '[arg]
initStackVarsPure
initLambdaStackVars (StorageLambda _) = Var arg -> StackVars (arg & extra)
forall st arg.
(HasStorage st, KnownValue arg) =>
Var arg -> StackVars '[arg, st]
initStackVars
initLambdaStackVars (EffLambda _) = Var arg -> StackVars (arg & extra)
forall st arg.
(HasSideEffects, HasStorage st, KnownValue arg) =>
Var arg -> StackVars '[arg, st, Ops]
initStackVarsEff
type Lambda1Generic extra arg res = (arg & extra) :-> (RetOutStack res ++ extra)
type CreateLambda1CGeneric extra arg res =
( ScopeCodeGen res, KnownValue arg, Typeable extra
, ZipInstr (arg & extra)
, KnownValue (ZippedStack (arg ': extra))
, KnownValue (ZippedStack (RetOutStack res ++ extra))
, ZipInstr (RetOutStack res ++ extra)
, Typeable (RetOutStack res ++ extra)
)
createLambda1Generic
:: forall arg res extra inp . CreateLambda1CGeneric extra arg res
=> Var (Lambda1Generic extra arg res)
-> res
-> StackVars (arg & extra)
-> SomeIndigoState (arg & extra)
-> IndigoState inp (Lambda1Generic extra arg res & inp)
createLambda1Generic :: Var (Lambda1Generic extra arg res)
-> res
-> StackVars (arg & extra)
-> SomeIndigoState (arg & extra)
-> IndigoState inp (Lambda1Generic extra arg res & inp)
createLambda1Generic var :: Var (Lambda1Generic extra arg res)
var ret :: res
ret initMd :: StackVars (arg & extra)
initMd act :: SomeIndigoState (arg & extra)
act = (MetaData inp -> GenCode inp (Lambda1Generic extra arg res & inp))
-> IndigoState inp (Lambda1Generic extra arg res & inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (Lambda1Generic extra arg res & inp))
-> IndigoState inp (Lambda1Generic extra arg res & inp))
-> (MetaData inp
-> GenCode inp (Lambda1Generic extra arg res & inp))
-> IndigoState inp (Lambda1Generic extra arg res & inp)
forall a b. (a -> b) -> a -> b
$ \MetaData{..} ->
SomeIndigoState (arg & extra)
-> MetaData (arg & extra)
-> (forall (out :: [*]).
GenCode (arg & extra) out
-> GenCode inp (Lambda1Generic extra arg res & inp))
-> GenCode inp (Lambda1Generic extra arg res & inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (arg & extra)
act (StackVars (arg & extra)
-> DecomposedObjects -> MetaData (arg & extra)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData StackVars (arg & extra)
initMd DecomposedObjects
forall a. Monoid a => a
mempty) ((forall (out :: [*]).
GenCode (arg & extra) out
-> GenCode inp (Lambda1Generic extra arg res & inp))
-> GenCode inp (Lambda1Generic extra arg res & inp))
-> (forall (out :: [*]).
GenCode (arg & extra) out
-> GenCode inp (Lambda1Generic extra arg res & inp))
-> GenCode inp (Lambda1Generic extra arg res & inp)
forall a b. (a -> b) -> a -> b
$ \gc :: GenCode (arg & extra) out
gc ->
let gcStack :: StackVars (Lambda1Generic extra arg res & inp)
gcStack = Var (Lambda1Generic extra arg res)
-> StackVars inp -> StackVars (Lambda1Generic extra arg res & inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var (Lambda1Generic extra arg res)
var StackVars inp
mdStack
gcCode :: inp :-> (Lambda1Generic extra arg res & inp)
gcCode = Lambda1Generic extra arg res
-> inp :-> (Lambda1Generic extra arg res & inp)
forall (i :: [*]) (o :: [*]) (s :: [*]).
ZipInstrs '[i, o] =>
(i :-> o) -> s :-> ((i :-> o) & s)
L.lambda (DecomposedObjects
-> GenCode (arg & extra) out
-> res
-> (arg & extra)
:-> (RetOutStack' (ClassifyReturnValue res) res ++ (arg & extra))
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope DecomposedObjects
mdObjects GenCode (arg & extra) out
gc res
ret ((arg & extra)
:-> (RetOutStack' (ClassifyReturnValue res) res ++ (arg & extra)))
-> ((RetOutStack' (ClassifyReturnValue res) res ++ (arg & extra))
:-> (RetOutStack' (ClassifyReturnValue res) res ++ extra))
-> Lambda1Generic extra arg res
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((arg & extra) :-> extra)
-> (RetOutStack' (ClassifyReturnValue res) res ++ (arg & extra))
:-> (RetOutStack' (ClassifyReturnValue res) res ++ extra)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
liftClear @res @extra @(arg & extra) (arg & extra) :-> extra
forall a (s :: [*]). (a & s) :-> s
L.drop)
gcClear :: (a & s) :-> s
gcClear = (a & s) :-> s
forall a (s :: [*]). (a & s) :-> s
L.drop
in $WGenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {..}
type CreateLambdaPure1C arg res = CreateLambda1CGeneric '[] arg res
type ExecuteLambdaPure1C arg res = ExecuteLambda1CGeneric '[] arg res
executeLambdaPure1
:: forall res arg inp. ExecuteLambdaPure1C arg res
=> RetVars res
-> LambdaExecutor '[] arg res inp
executeLambdaPure1 :: RetVars res -> LambdaExecutor '[] arg res inp
executeLambdaPure1 retVars :: RetVars res
retVars = RetVars res
-> IndigoState inp ('[] ++ inp) -> LambdaExecutor '[] arg res inp
forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic @res RetVars res
retVars IndigoState inp ('[] ++ inp)
forall (inp :: [*]). IndigoState inp inp
nopState
initStackVarsPure :: KnownValue arg => Var arg -> StackVars '[arg]
initStackVarsPure :: Var arg -> StackVars '[arg]
initStackVarsPure var :: Var arg
var = Var arg -> StackVars '[] -> StackVars '[arg]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var arg
var StackVars '[]
emptyStack
type CreateLambda1C st arg res = (KnownValue st, CreateLambda1CGeneric '[st] arg res)
type ExecuteLambda1C st arg res =
( IsObject st
, HasStorage st
, ExecuteLambda1CGeneric '[st] arg res
)
executeLambdaSt1
:: forall res st arg inp. ExecuteLambda1C st arg res
=> RefId
-> RetVars res
-> LambdaExecutor '[st] arg res inp
executeLambdaSt1 :: RefId -> RetVars res -> LambdaExecutor '[st] arg res inp
executeLambdaSt1 nextRef :: RefId
nextRef retVars :: RetVars res
retVars = RetVars res
-> IndigoState inp ('[st] ++ inp)
-> LambdaExecutor '[st] arg res inp
forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic @res RetVars res
retVars (IndigoState inp ('[st] ++ inp)
-> LambdaExecutor '[st] arg res inp)
-> IndigoState inp ('[st] ++ inp)
-> LambdaExecutor '[st] arg res inp
forall a b. (a -> b) -> a -> b
$
(MetaData inp -> GenCode inp (st & inp))
-> IndigoState inp ('[st] ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (st & inp))
-> IndigoState inp ('[st] ++ inp))
-> (MetaData inp -> GenCode inp (st & inp))
-> IndigoState inp ('[st] ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
let storage :: Var st
storage = HasStorage st => Var st
forall st. HasStorage st => Var st
storageVar @st
GenCode gcStack :: StackVars (st & inp)
gcStack fetchCode :: inp :-> (st & inp)
fetchCode _ = MetaData inp
-> IndigoState inp (st & inp) -> GenCode inp (st & inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp (st & inp) -> GenCode inp (st & inp))
-> IndigoState inp (st & inp) -> GenCode inp (st & inp)
forall a b. (a -> b) -> a -> b
$ Expr st -> IndigoState inp (st & inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
storage)
tmpVar :: Var st
tmpVar = RefId -> Var st
forall k (a :: k). RefId -> Var a
Var RefId
nextRef
gcClear :: (st & inp) :-> inp
gcClear = GenCode (st & inp) (st & inp) -> (st & inp) :-> (st & inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (MetaData (st & inp)
-> IndigoState (st & inp) (st & inp)
-> GenCode (st & inp) (st & inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (Var st -> MetaData inp -> MetaData (st & inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a & inp)
pushRefMd Var st
tmpVar MetaData inp
md) (IndigoState (st & inp) (st & inp)
-> GenCode (st & inp) (st & inp))
-> IndigoState (st & inp) (st & inp)
-> GenCode (st & inp) (st & inp)
forall a b. (a -> b) -> a -> b
$
RefId -> Var st -> Expr st -> IndigoState (st & inp) (st & inp)
forall a (inp :: [*]).
KnownValue a =>
RefId -> Var a -> Expr a -> IndigoState inp inp
setVar (RefId
nextRef RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ 1) Var st
storage (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
tmpVar))
# L.drop
in $WGenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {gcCode :: inp :-> (st & inp)
gcCode=inp :-> (st & inp)
fetchCode,..}
initStackVars :: (HasStorage st, KnownValue arg) => Var arg -> StackVars '[arg, st]
initStackVars :: Var arg -> StackVars '[arg, st]
initStackVars var :: Var arg
var = StackVars '[]
emptyStack
StackVars '[]
-> (StackVars '[] -> StackVars '[st]) -> StackVars '[st]
forall a b. a -> (a -> b) -> b
& Var st -> StackVars '[] -> StackVars '[st]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var st
forall st. HasStorage st => Var st
storageVar
StackVars '[st]
-> (StackVars '[st] -> StackVars '[arg, st])
-> StackVars '[arg, st]
forall a b. a -> (a -> b) -> b
& Var arg -> StackVars '[st] -> StackVars '[arg, st]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var arg
var
type CreateLambdaEff1C st arg res = (KnownValue st, CreateLambda1CGeneric '[st, Ops] arg res)
type ExecuteLambdaEff1C st arg res =
( HasStorage st
, HasSideEffects
, IsObject st
, ExecuteLambda1CGeneric '[st, Ops] arg res
)
executeLambdaEff1
:: forall res st arg inp. ExecuteLambdaEff1C st arg res
=> RefId
-> RetVars res
-> LambdaExecutor '[st, Ops] arg res inp
executeLambdaEff1 :: RefId -> RetVars res -> LambdaExecutor '[st, Ops] arg res inp
executeLambdaEff1 nextRef :: RefId
nextRef retVars :: RetVars res
retVars =
RetVars res
-> IndigoState inp ('[st, Ops] ++ inp)
-> LambdaExecutor '[st, Ops] arg res inp
forall res arg (extra :: [*]) (inp :: [*]).
ExecuteLambda1CGeneric extra arg res =>
RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic @res RetVars res
retVars (IndigoState inp ('[st, Ops] ++ inp)
-> LambdaExecutor '[st, Ops] arg res inp)
-> IndigoState inp ('[st, Ops] ++ inp)
-> LambdaExecutor '[st, Ops] arg res inp
forall a b. (a -> b) -> a -> b
$
(MetaData inp -> GenCode inp (st & (Ops : inp)))
-> IndigoState inp ('[st, Ops] ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (st & (Ops : inp)))
-> IndigoState inp ('[st, Ops] ++ inp))
-> (MetaData inp -> GenCode inp (st & (Ops : inp)))
-> IndigoState inp ('[st, Ops] ++ inp)
forall a b. (a -> b) -> a -> b
$ \MetaData{..} ->
let storage :: Var st
storage = HasStorage st => Var st
forall st. HasStorage st => Var st
storageVar @st
ops :: Var Ops
ops@(Var opsRefId :: RefId
opsRefId) = Var Ops
HasSideEffects => Var Ops
operationsVar
gcStack :: StackVars (st & (Ops : inp))
gcStack = Var st -> StackVars (Ops : inp) -> StackVars (st & (Ops : inp))
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var st
storage (StackVars (Ops : inp) -> StackVars (st & (Ops : inp)))
-> StackVars (Ops : inp) -> StackVars (st & (Ops : inp))
forall a b. (a -> b) -> a -> b
$ Var Ops -> StackVars inp -> StackVars (Ops : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var Ops
ops StackVars inp
mdStack
fetchCode :: inp :-> (st & (Ops : inp))
fetchCode =
RefId -> StackVars inp -> inp :-> (Ops : inp)
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> stk :-> (a & stk)
varActionGet RefId
opsRefId StackVars inp
mdStack (inp :-> (Ops : inp))
-> ((Ops : inp) :-> (st & (Ops : inp)))
-> inp :-> (st & (Ops : inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(GenCode (Ops : inp) (st & (Ops : inp))
-> (Ops : inp) :-> (st & (Ops : inp))
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode (Ops : inp) (st & (Ops : inp))
-> (Ops : inp) :-> (st & (Ops : inp)))
-> GenCode (Ops : inp) (st & (Ops : inp))
-> (Ops : inp) :-> (st & (Ops : inp))
forall a b. (a -> b) -> a -> b
$ MetaData (Ops : inp)
-> IndigoState (Ops : inp) (st & (Ops : inp))
-> GenCode (Ops : inp) (st & (Ops : inp))
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (StackVars (Ops : inp) -> DecomposedObjects -> MetaData (Ops : inp)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData StackVars (Ops : inp)
sPlus DecomposedObjects
mdObjects) (IndigoState (Ops : inp) (st & (Ops : inp))
-> GenCode (Ops : inp) (st & (Ops : inp)))
-> IndigoState (Ops : inp) (st & (Ops : inp))
-> GenCode (Ops : inp) (st & (Ops : inp))
forall a b. (a -> b) -> a -> b
$ Expr st -> IndigoState (Ops : inp) (st & (Ops : inp))
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
storage))
sPlus :: StackVars (Ops : inp)
sPlus = StkEl Ops
forall a. KnownValue a => StkEl a
NoRef StkEl Ops -> StackVars inp -> StackVars (Ops : inp)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StackVars inp
mdStack
tmpVar :: Var st
tmpVar = RefId -> Var st
forall k (a :: k). RefId -> Var a
Var RefId
nextRef
setStorage :: (st & (Ops : inp)) :-> (Ops : inp)
setStorage = GenCode (st & (Ops : inp)) (st & (Ops : inp))
-> (st & (Ops : inp)) :-> (st & (Ops : inp))
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (MetaData (st & (Ops : inp))
-> IndigoState (st & (Ops : inp)) (st & (Ops : inp))
-> GenCode (st & (Ops : inp)) (st & (Ops : inp))
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (StackVars (st & (Ops : inp))
-> DecomposedObjects -> MetaData (st & (Ops : inp))
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData (Var st -> StackVars (Ops : inp) -> StackVars (st & (Ops : inp))
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var st
tmpVar StackVars (Ops : inp)
sPlus) DecomposedObjects
mdObjects) (IndigoState (st & (Ops : inp)) (st & (Ops : inp))
-> GenCode (st & (Ops : inp)) (st & (Ops : inp)))
-> IndigoState (st & (Ops : inp)) (st & (Ops : inp))
-> GenCode (st & (Ops : inp)) (st & (Ops : inp))
forall a b. (a -> b) -> a -> b
$
RefId
-> Var st
-> Expr st
-> IndigoState (st & (Ops : inp)) (st & (Ops : inp))
forall a (inp :: [*]).
KnownValue a =>
RefId -> Var a -> Expr a -> IndigoState inp inp
setVar (RefId
nextRef RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ 1) Var st
storage (Var st -> Expr st
forall a. KnownValue a => Var a -> Expr a
V Var st
tmpVar))
# L.drop
gcClear :: (st & (Ops : inp)) :-> inp
gcClear = (st & (Ops : inp)) :-> (Ops : inp)
setStorage ((st & (Ops : inp)) :-> (Ops : inp))
-> ((Ops : inp) :-> inp) -> (st & (Ops : inp)) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# RefId -> StackVars inp -> (Ops : inp) :-> inp
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> (a & stk) :-> stk
varActionSet RefId
opsRefId StackVars inp
mdStack
in $WGenCode :: forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode {gcCode :: inp :-> (st & (Ops : inp))
gcCode=inp :-> (st & (Ops : inp))
fetchCode,..}
initStackVarsEff
:: (HasSideEffects, HasStorage st, KnownValue arg)
=> Var arg -> StackVars '[arg, st, Ops]
initStackVarsEff :: Var arg -> StackVars '[arg, st, Ops]
initStackVarsEff var :: Var arg
var = StackVars '[]
emptyStack
StackVars '[]
-> (StackVars '[] -> StackVars '[Ops]) -> StackVars '[Ops]
forall a b. a -> (a -> b) -> b
& Var Ops -> StackVars '[] -> StackVars '[Ops]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var Ops
HasSideEffects => Var Ops
operationsVar
StackVars '[Ops]
-> (StackVars '[Ops] -> StackVars '[st, Ops])
-> StackVars '[st, Ops]
forall a b. a -> (a -> b) -> b
& Var st -> StackVars '[Ops] -> StackVars '[st, Ops]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var st
forall st. HasStorage st => Var st
storageVar
StackVars '[st, Ops]
-> (StackVars '[st, Ops] -> StackVars '[arg, st, Ops])
-> StackVars '[arg, st, Ops]
forall a b. a -> (a -> b) -> b
& Var arg -> StackVars '[st, Ops] -> StackVars '[arg, st, Ops]
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a & inp)
pushRef Var arg
var
type ExecuteLambda1CGeneric extra arg res =
( ScopeCodeGen res, KnownValue arg
, KnownValue ((arg & extra) :-> (RetOutStack res ++ extra))
, KnownList extra
, ZipInstr (arg & extra)
, KnownList (RetOutStack res ++ extra)
, ZipInstr (RetOutStack res ++ extra)
, Typeable (RetOutStack res ++ extra)
, KnownValue (ZippedStack (RetOutStack res ++ extra))
)
type LambdaExecutor extra arg res inp
= Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic
:: forall res arg extra inp . ExecuteLambda1CGeneric extra arg res
=> RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic :: RetVars res
-> IndigoState inp (extra ++ inp)
-> Var (Lambda1Generic extra arg res)
-> Expr arg
-> IndigoState inp (RetOutStack res ++ inp)
executeLambda1Generic vars :: RetVars res
vars allocateCleanup :: IndigoState inp (extra ++ inp)
allocateCleanup varF :: Var (Lambda1Generic extra arg res)
varF argm :: Expr arg
argm = (MetaData inp -> GenCode inp (RetOutStack res ++ inp))
-> IndigoState inp (RetOutStack res ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (RetOutStack res ++ inp))
-> IndigoState inp (RetOutStack res ++ inp))
-> (MetaData inp -> GenCode inp (RetOutStack res ++ inp))
-> IndigoState inp (RetOutStack res ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{..} ->
let GenCode allocStk :: StackVars (extra ++ inp)
allocStk allocate :: inp :-> (extra ++ inp)
allocate cleanup :: (extra ++ inp) :-> inp
cleanup = MetaData inp
-> IndigoState inp (extra ++ inp) -> GenCode inp (extra ++ inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md IndigoState inp (extra ++ inp)
allocateCleanup in
let getArgs :: inp :-> (Lambda1Generic extra arg res & (arg & (extra ++ inp)))
getArgs =
inp :-> (extra ++ inp)
allocate (inp :-> (extra ++ inp))
-> ((extra ++ inp)
:-> (Lambda1Generic extra arg res & (arg & (extra ++ inp))))
-> inp :-> (Lambda1Generic extra arg res & (arg & (extra ++ inp)))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(GenCode
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
-> (extra ++ inp)
:-> (Lambda1Generic extra arg res & (arg & (extra ++ inp)))
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
-> (extra ++ inp)
:-> (Lambda1Generic extra arg res & (arg & (extra ++ inp))))
-> GenCode
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
-> (extra ++ inp)
:-> (Lambda1Generic extra arg res & (arg & (extra ++ inp)))
forall a b. (a -> b) -> a -> b
$
MetaData (extra ++ inp)
-> IndigoState
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
-> GenCode
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState (StackVars (extra ++ inp)
-> DecomposedObjects -> MetaData (extra ++ inp)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData StackVars (extra ++ inp)
allocStk DecomposedObjects
mdObjects) (IndigoState
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
-> GenCode
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp))))
-> IndigoState
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
-> GenCode
(extra ++ inp)
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
forall a b. (a -> b) -> a -> b
$ do
Expr arg -> IndigoState (extra ++ inp) (arg & (extra ++ inp))
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr Expr arg
argm
Expr (Lambda1Generic extra arg res)
-> IndigoState
(arg & (extra ++ inp))
(Lambda1Generic extra arg res & (arg & (extra ++ inp)))
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp)
compileExpr (Var (Lambda1Generic extra arg res)
-> Expr (Lambda1Generic extra arg res)
forall a. KnownValue a => Var a -> Expr a
V Var (Lambda1Generic extra arg res)
varF)) in
case Dict (ConcatListOfTypesAssociativity (RetOutStack res) extra inp)
forall k (a :: [k]) (b :: [k]) (c :: [k]).
Dict (ConcatListOfTypesAssociativity a b c)
listOfTypesConcatAssociativityAxiom @(RetOutStack res) @extra @inp of
Dict ->
let code :: inp :-> (RetOutStack res ++ inp)
code = inp :-> (Lambda1Generic extra arg res & (arg & (extra ++ inp)))
getArgs (inp :-> (Lambda1Generic extra arg res & (arg & (extra ++ inp))))
-> ((Lambda1Generic extra arg res & (arg & (extra ++ inp)))
:-> (RetOutStack res ++ (extra ++ inp)))
-> inp :-> (RetOutStack res ++ (extra ++ inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
Each
'[KnownList, ZipInstr] '[arg & extra, RetOutStack res ++ extra] =>
(Lambda1Generic extra arg res : ((arg & extra) ++ inp))
:-> ((RetOutStack res ++ extra) ++ inp)
forall (i :: [*]) (o :: [*]) (s :: [*]).
Each '[KnownList, ZipInstr] '[i, o] =>
((i :-> o) : (i ++ s)) :-> (o ++ s)
L.execute @_ @_ @inp (inp :-> (RetOutStack res ++ (extra ++ inp)))
-> ((RetOutStack res ++ (extra ++ inp))
:-> (RetOutStack res ++ inp))
-> inp :-> (RetOutStack res ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
((extra ++ inp) :-> inp)
-> (RetOutStack res ++ (extra ++ inp)) :-> (RetOutStack res ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
liftClear @res (extra ++ inp) :-> inp
cleanup
in StackVars inp
-> RetVars res
-> (inp :-> (RetOutStack res ++ inp))
-> GenCode inp (RetOutStack res ++ inp)
forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @res StackVars inp
mdStack RetVars res
vars inp :-> (RetOutStack res ++ inp)
code