The closure analizer gets run once more when a lambda form appears in a FUNCTION special form, and also after compiling the body of a FLET/LABELS form, because both can change the nature of the function.

This commit is contained in:
jgarcia 2007-01-19 18:08:52 +00:00
parent 1406d71188
commit 7d65881610
3 changed files with 29 additions and 6 deletions

View file

@ -128,6 +128,13 @@ ECL 1.0:
- ENOUGH-NAMESTRING did not simplify a pathname when it had the same directory
as the default pathname.
- Some toplevel forms with closures caused the compiler to abort, for example
(let ((data '(a b)))
(flet ((get-it ()
(second data)))
(defun print-it-1 ()
(print (get-it)))))
* Unicode:
- MAKE-STRING only allowed :ELEMENT-TYPE to be one of CHARACTER, BASE-CHAR, or

View file

@ -72,6 +72,15 @@
;; in a LABELS can reference each other.
(setf local-funs (remove-if-not #'plusp local-funs :key #'fun-ref))
;; Keep on inspecting the functions until the closure type does not
;; change.
(loop while
(let ((x nil))
(loop for f in local-funs
when (compute-fun-closure-type f)
do (setf x t))
x))
(if local-funs
(make-c1form* 'LOCALS :type (c1form-type body-c1form)
:args local-funs body-c1form (eq origin 'LABELS))
@ -130,6 +139,10 @@
(setf (fun-closure fun) new-type)
;; All external, non-global variables become of type closure
(when (eq new-type 'CLOSURE)
(when (fun-global fun)
(error "Function ~A is global but is closed over some variables.~%~
~{~A ~}"
(fun-name fun) (mapcar #'var-name (fun-referred-vars fun))))
(dolist (var (fun-referred-local-vars fun))
(setf (var-ref-clb var) nil
(var-ref-ccb var) t

View file

@ -71,12 +71,15 @@
((and (consp fun) (member (car fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
(cmpck (endp (cdr fun))
"The lambda expression ~s is illegal." fun)
(let* ((name (when (eq (first fun) 'EXT::LAMBDA-BLOCK)
(or (first (setf fun (rest fun)))
(cmpwarn "LAMBDA-BLOCK has block name NIL~%Name will be ignored."))))
(fun (c1compile-function (rest fun) :name name))
(lambda-form (fun-lambda fun)))
(make-c1form 'FUNCTION lambda-form 'CLOSURE lambda-form fun)))
(let (name body)
(if (eq (first fun) 'EXT::LAMBDA)
(setf name (gensym) body (rest fun))
(setf name (second fun) body (cddr fun)))
(let* ((funob (c1compile-function body :name name))
(lambda-form (fun-lambda funob)))
(setf (fun-ref-ccb funob) t)
(compute-fun-closure-type funob)
(make-c1form 'FUNCTION lambda-form 'CLOSURE lambda-form funob))))
(t (cmperr "The function ~s is illegal." fun)))))
(defun c2function (kind funob fun)