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

In cmpflet.lsp, child-p is now a standalone, non-recursive function

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-11-11 01:21:15 +01:00
parent 1f7c3a2ab7
commit 4f83a0317c
1 changed files with 11 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/cmp/cmpflet.lsp
View file

@ -88,8 +88,16 @@
:args local-funs body-c1form (eq origin 'LABELS))
body-c1form)))
(defun child-function-p (presumed-parent fun)
(declare (si::c-local))
(loop for real-parent = (fun-parent fun)
while real-parent
do (if (eq real-parent presumed-parent)
(return t)
(setf fun real-parent))))
(defun compute-fun-closure-type (fun)
(labels
(flet
((closure-type (fun)
(let ((closure nil))
;; it will have a full closure if it refers external non-global variables
@ -101,7 +109,7 @@
(unless closure (setf closure 'LEXICAL)))))
;; ...or if it directly calls a function
(dolist (f (fun-referenced-funs fun))
(unless (child-p fun f)
(unless (child-function-p fun f)
;; .. which has a full closure
(case (fun-closure f)
(CLOSURE (setf closure 'CLOSURE))
@ -112,12 +120,7 @@
(and (fun-var fun)
(plusp (var-ref (fun-var fun)))))
(setf closure 'CLOSURE)))
closure))
(child-p (presumed-parent fun)
(let ((real-parent (fun-parent fun)))
(when real-parent
(or (eq real-parent presumed-parent)
(child-p real-parent presumed-parent))))))
closure)))
;; This recursive algorithm is guaranteed to stop when functions
;; do not change.
(let ((new-type (closure-type fun))