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

COMPUTE-CLOSURE-TYPE stops earlier when it finds that the type is a full closure.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-11-11 02:02:01 +01:00
parent f316c42396
commit cd7af81f8a
1 changed files with 15 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

29
src/cmp/cmpflet.lsp
View file

@ -98,28 +98,29 @@
(defun compute-closure-type (fun)
(declare (si::c-local))
(let ((closure nil))
(let ((lexical-closure-p nil))
;; it will have a full closure if it refers external non-global variables
(dolist (var (fun-referenced-vars fun))
(unless (global-var-p var)
;; ...across CB
(if (ref-ref-ccb var)
(setf closure 'CLOSURE)
(unless closure (setf closure 'LEXICAL)))))
(cond ((global-var-p var))
;; ...across CB
((ref-ref-ccb var)
(return-from compute-closure-type 'CLOSURE))
(t
(setf lexical-closure-p t))))
;; ...or if it directly calls a function
(dolist (f (fun-referenced-funs fun))
(unless (child-function-p fun f)
;; .. which has a full closure
(case (fun-closure f)
(CLOSURE (setf closure 'CLOSURE))
(LEXICAL (unless closure (setf closure 'LEXICAL))))))
(CLOSURE (return-from compute-closure-type 'CLOSURE))
(LEXICAL (setf lexical-closure-p t)))))
;; ...or the function itself is referred across CB
(when closure
(when (or (fun-ref-ccb fun)
(and (fun-var fun)
(plusp (var-ref (fun-var fun)))))
(setf closure 'CLOSURE)))
closure))
(when lexical-closure-p
(if (or (fun-ref-ccb fun)
(and (fun-var fun)
(plusp (var-ref (fun-var fun)))))
'CLOSURE
'LEXICAL))))
(defun update-fun-closure-type-many (function-list)
(do ((finish nil t)