mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-04 08:20:45 -08:00
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:
parent
1406d71188
commit
7d65881610
3 changed files with 29 additions and 6 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue