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

Fix: recursive functions correctly defunctionalized

Browse source
This commit is contained in:
Théophile Bastian 2018-02-16 01:29:01 +01:00
parent 29a2ef43a1
commit c84a1ac169
1 changed files with 13 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/Defun.ml
View file

@ -66,7 +66,6 @@ let rec walk_term fs t =
let fs, nNext = walk_term fs next in
fs, T.LetVal(var, value, nNext)
| S.LetBlo (var, S.Lam(self, vars, body), next) ->
(* FIXME is handling of recursive functions correct? *)
let fs, nNext = walk_term fs next in
let fs, nBody = walk_term fs body in
let arity = List.length vars + 1 in
@ -77,18 +76,24 @@ let rec walk_term fs t =
vars
(S.vvars (List.tl args)) in
let thisTag = freshTag () in
let selfVars = (match self with
| S.Self self -> Atom.Set.singleton self
| S.NoSelf -> Atom.Set.empty) in
let freeVars = Atom.Set.elements @@
let freeVars =
Atom.Set.diff
(S.fv_term body)
(Atom.Set.union (Atom.Set.of_list vars) selfVars)
(Atom.Set.of_list vars)
in
let freeVarsBranch, freeVarsCon = (match self with
| S.Self self ->
let freeVars = Atom.Set.elements @@
Atom.Set.diff freeVars
(Atom.Set.singleton self) in
self :: freeVars, var :: freeVars
| S.NoSelf ->
let freeVars = Atom.Set.elements freeVars in
freeVars, freeVars) in
let thisFunc =
T.Branch(thisTag, freeVars, nBody) in
T.Branch(thisTag, freeVarsBranch, nBody) in
let fs = add_func fs arity thisFunc in
fs, T.LetBlo (var, T.Con(thisTag, T.vvars freeVars), nNext)
fs, T.LetBlo (var, T.Con(thisTag, T.vvars freeVarsCon), nNext)
| S.IfZero (value, tIf, tElse) ->
let fs, tIf = walk_term fs tIf in
let fs, tElse = walk_term fs tElse in