mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-01 23:30:40 -08:00
When dealing with compiler-macros, ECL may enter an infinite loop.
This commit is contained in:
parent
c972e21255
commit
e10ee7808b
3 changed files with 28 additions and 3 deletions
|
|
@ -1194,6 +1194,9 @@ ECLS 0.9
|
|||
|
||||
- DESTRUCTURING-BIND fails to interpret &WHOLE arguments.
|
||||
|
||||
- The compiler might get into an infinite loop when dealing with
|
||||
compiler-macros.
|
||||
|
||||
* Errors of the interpreter:
|
||||
|
||||
- CASE should use EQL to compare objects, not EQ.
|
||||
|
|
|
|||
|
|
@ -86,8 +86,12 @@
|
|||
(funcall fd args)))
|
||||
((setq fd (macro-function fname))
|
||||
(c1expr (cmp-expand-macro fd fname args)))
|
||||
((setq fd (compiler-macro-function fname))
|
||||
(c1expr (funcall fd (cons fname args) nil)))
|
||||
((and (setq fd (compiler-macro-function fname))
|
||||
(let ((success nil))
|
||||
(multiple-value-setq (fd success)
|
||||
(cmp-expand-compiler-macro fd fname args))
|
||||
success))
|
||||
(c1expr fd))
|
||||
((and (setq fd (get fname 'SYS::STRUCTURE-ACCESS))
|
||||
(inline-possible fname)
|
||||
;;; Structure hack.
|
||||
|
|
@ -95,8 +99,9 @@
|
|||
(sys::fixnump (cdr fd))
|
||||
(not (endp args))
|
||||
(endp (cdr args)))
|
||||
(print args *standard-output*)(terpri *standard-output*)
|
||||
(case (car fd)
|
||||
(VECTOR (c1expr `(svref ,(car args) ,(cdr fd)))) ; Beppe
|
||||
(VECTOR (c1expr `(svref ,(car args) ,(cdr fd)))) ; Beppe3
|
||||
(LIST (c1expr `(sys:list-nth ,(cdr fd) ,(car args))))
|
||||
(t (c1structure-ref1 (car args) (car fd) (cdr fd)))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -131,6 +131,23 @@
|
|||
~%;;; You are recommended to compile again.~%"
|
||||
fname)))))
|
||||
|
||||
(defun cmp-expand-compiler-macro (fd fname args &aux env (throw-flag t))
|
||||
(dolist (v *funs*)
|
||||
(when (consp v) (push v env)))
|
||||
(when env (setq env (cons nil (nreverse env))))
|
||||
(let ((form (cons fname args)))
|
||||
(unwind-protect
|
||||
(let ((new-form (cmp-toplevel-eval `(funcall *macroexpand-hook* ',fd ',form ',env))))
|
||||
(setq throw-flag nil)
|
||||
(values new-form (not (eql new-form form))))
|
||||
(when throw-flag
|
||||
(let ((*print-case* :upcase))
|
||||
(print-current-form)
|
||||
(format t
|
||||
"~&;;; The macro form (~s ...) was not expanded successfully.~
|
||||
~%;;; You are recommended to compile again.~%"
|
||||
fname))))))
|
||||
|
||||
(defun cmp-toplevel-eval (form)
|
||||
(let*
|
||||
#-:CCL
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue