Light CPS: implement lambdas
This commit is contained in:
parent
613adf0621
commit
f5783f2b2b
1 changed files with 15 additions and 10 deletions
21
src/CPS.ml
21
src/CPS.ml
|
@ -29,7 +29,7 @@ let letCont name varName body next =
|
||||||
|
|
||||||
let rec has_calls (t: S.term): bool = match t with
|
let rec has_calls (t: S.term): bool = match t with
|
||||||
| S.Var _ | S.Lit _ | S.BinOp _ -> false
|
| S.Var _ | S.Lit _ | S.BinOp _ -> false
|
||||||
| S.Lam _ -> true (* TODO *)
|
| S.Lam _ -> false
|
||||||
(* A lambda itself may contain calls, but this call is not evaluated at
|
(* A lambda itself may contain calls, but this call is not evaluated at
|
||||||
* declaration time *)
|
* declaration time *)
|
||||||
| S.App _ -> true
|
| S.App _ -> true
|
||||||
|
@ -60,12 +60,10 @@ let rec cps_term_inner (t: S.term) (cont: T.variable) (nameHint: string option)
|
||||||
| S.Var _ -> cps_value_as_term t cont
|
| S.Var _ -> cps_value_as_term t cont
|
||||||
| S.Lit _ -> cps_value_as_term t cont
|
| S.Lit _ -> cps_value_as_term t cont
|
||||||
| S.BinOp _ -> cps_value_as_term t cont
|
| S.BinOp _ -> cps_value_as_term t cont
|
||||||
| S.Lam (self, var, term) ->
|
| S.Lam _ as lambda ->
|
||||||
let fName = freshBlockVarHinted nameHint
|
let fName = freshBlockVarHinted nameHint in
|
||||||
and innerCont = freshBlockVar () in
|
light_term fName lambda None @@
|
||||||
T.LetBlo(fName,
|
T.TailCall(T.vvar cont, T.vvars [fName])
|
||||||
T.Lam(self, [var; innerCont], cps_term_inner term innerCont None),
|
|
||||||
T.TailCall(T.vvar cont, T.vvars [fName]))
|
|
||||||
| S.App (f, x) ->
|
| S.App (f, x) ->
|
||||||
let xVal = freshVarHinted nameHint
|
let xVal = freshVarHinted nameHint
|
||||||
and fVal = freshVar () in
|
and fVal = freshVar () in
|
||||||
|
@ -108,7 +106,14 @@ and light_term varName valExpr valHint next =
|
||||||
subLetVar,
|
subLetVar,
|
||||||
cps_value subLetVal,
|
cps_value subLetVal,
|
||||||
light_term varName subLetNext valHint next)
|
light_term varName subLetNext valHint next)
|
||||||
| S.Lam _ | S.App _ | S.Print _ | S.IfZero _ -> assert false
|
| S.Lam(self, lamVar, lamBody) ->
|
||||||
|
let lamCont = freshBlockVar () in
|
||||||
|
T.LetBlo (
|
||||||
|
varName, T.Lam(
|
||||||
|
self, [lamVar; lamCont],
|
||||||
|
cps_term_inner lamBody lamCont None),
|
||||||
|
next)
|
||||||
|
| S.App _ | S.Print _ | S.IfZero _ -> assert false
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue