tobast/mpri-funcprog-project
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Light CPS: implement lambdas

Browse source
This commit is contained in:
Théophile Bastian 2018-02-16 15:29:36 +01:00
parent 613adf0621
commit f5783f2b2b
1 changed files with 15 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
src/CPS.ml
View file

@ -29,9 +29,9 @@ 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
| S.IfZero (cond, tIf, tElse) -> | S.IfZero (cond, tIf, tElse) ->
(* Cannot optimize continuation creation (* Cannot optimize continuation creation
@ -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
) )