mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 22:01:36 -08:00
Code Issues Projects Releases Packages Wiki Activity

Use mutual references to do some backtracking in LABELS forms, updating the functions that recursively call the LABELS functions.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-11-11 18:35:57 +01:00
parent 44cf97c512
commit b970c5b206
2 changed files with 13 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

17
src/cmp/cmpflet.lsp
View file

@ -55,12 +55,17 @@
;; When we are in a LABELs form, we have to propagate the external
;; variables from one function to the other functions that use it.
(when (eq origin 'LABELS)
(dolist (f1 local-funs)
(let ((vars (fun-referenced-vars f1)))
(dolist (f2 local-funs)
(when (and (not (eq f1 f2))
(member f1 (fun-referenced-funs f2) :test #'eq))
(add-to-fun-referenced-vars f2 vars))))))
(loop for change = nil
do (loop for f1 in local-funs
for vars = (fun-referenced-vars f1)
for funs = (fun-referenced-funs f1)
do (loop for f2 in (fun-referencing-funs f1)
for c1 = (add-to-fun-referenced-vars f2 vars)
for c2 = (add-to-fun-referenced-funs f2 funs)
for c3 = (update-fun-closure-type f2)
when (or c1 c2 c3)
do (setf change t)))
do (unless change (return))))
;; Now we can compile the body itself.
(let ((*cmp-env* new-env))

3
src/cmp/cmplam.lsp
View file

@ -85,7 +85,8 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
(loop with new-funs = (fun-referenced-funs fun)
with change = nil
for f in fun-list
when (and (not (member f new-funs :test #'eq))
when (and (not (eq fun f))
(not (member f new-funs :test #'eq))
(not (child-function-p fun f)))
do (setf change t
new-funs (cons f new-funs)