Commit c3a38a27 authored by Alexey Dejneka's avatar Alexey Dejneka
Browse files

0.pre8.82:

        Fixed bugs caught by Paul Dietz' test suite:
        * CONVERT-MORE-CALL failed on ((LAMBDA (&KEY) 1)
          :ALLOW-OTHER-KEYS T) (fixed by Gerd Moellmann);
        * &WHOLE and &REST arguments in a macro lambda list may be
          patterns.
parent 545603e9
Loading
Loading
Loading
Loading
+4 −0
Original line number Diff line number Diff line
@@ -1315,6 +1315,10 @@ WORKAROUND:
  (When this is fixed, the ROOM entries in tests/smoke.impure.lisp
  should be uncommented.)

248: "reporting errors in type specifier syntax"
  (TYPEP 1 '(SYMBOL NIL)) says something about "unknown type
  specifier".

DEFUNCT CATEGORIES OF BUGS
  IR1-#:
    These labels were used for bugs related to the old IR1 interpreter.
+5 −2
Original line number Diff line number Diff line
@@ -1677,6 +1677,9 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
       causes an error;
    ** condition slots are now initialized once each, not multiple
       times;  (thanks to Gerd Moellmann)
    ** CONVERT-MORE-CALL failed on a lambda list (&KEY);  (thanks to
       Gerd Moellmann)
    ** &WHOLE and &REST arguments in macro lambda lists are patterns;

planned incompatible changes in 0.8.x:
  * (not done yet, but planned:) When the profiling interface settles
+1 −1
Original line number Diff line number Diff line
@@ -96,9 +96,9 @@
 ("src/compiler/target/parms")
 ("src/code/early-array") ; needs "early-vm" numbers

 ("src/code/early-extensions") ; on host for COLLECT, SYMBOLICATE, etc.
 ("src/code/parse-body")       ; on host for PARSE-BODY
 ("src/code/parse-defmacro")   ; on host for PARSE-DEFMACRO
 ("src/code/early-extensions") ; on host for COLLECT, SYMBOLICATE, etc.
 ("src/compiler/deftype")      ; on host for SB!XC:DEFTYPE
 ("src/compiler/defconstant")
 ("src/code/early-alieneval")  ; for vars needed both at build and run time
+116 −107
Original line number Diff line number Diff line
@@ -100,57 +100,24 @@
      (error "&WHOLE may only appear first in ~S lambda-list." error-kind))
    (do ((rest-of-args lambda-list (cdr rest-of-args)))
	((null rest-of-args))
      (macrolet ((process-sublist (var sublist-name path)
                   (once-only ((var var))
                     `(if (consp ,var)
                          (let ((sub-list-name (gensym ,sublist-name)))
                            (push-sub-list-binding sub-list-name ,path ,var
                                                   name error-kind error-fun)
                            (parse-defmacro-lambda-list ,var sub-list-name name
                                                        error-kind error-fun))
                          (push-let-binding ,var ,path nil)))))
        (let ((var (car rest-of-args)))
	(cond ((eq var '&whole)
	       (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
		      (setq rest-of-args (cdr rest-of-args))
		      (push-let-binding (car rest-of-args) arg-list-name nil))
		     (t
		      (defmacro-error "&WHOLE" error-kind name))))
	      ((eq var '&environment)
	       (cond (env-illegal
		      (error "&ENVIRONMENT is not valid with ~S." error-kind))
		     ((not toplevel)
		      (error "&ENVIRONMENT is only valid at top level of ~
			      lambda-list.")))
	       (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
		      (setq rest-of-args (cdr rest-of-args))
		      (push-let-binding (car rest-of-args) env-arg-name nil)
		      (setq env-arg-used t))
		     (t
		      (defmacro-error "&ENVIRONMENT" error-kind name))))
	      ((or (eq var '&rest)
		   (eq var '&body))
	       (cond (restp
		      (defmacro-error (symbol-name var) error-kind name))
		     ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
		      (setq rest-of-args (cdr rest-of-args))
		      (setq restp t)
		      (push-let-binding (car rest-of-args) path nil))
		     (t
		      (defmacro-error (symbol-name var) error-kind name))))
	      ((eq var '&optional)
	       (setq now-processing :optionals))
	      ((eq var '&key)
	       (setq now-processing :keywords)
	       (setq rest-name (gensym "KEYWORDS-"))
	       (push rest-name *ignorable-vars*)
	       (setq restp t)
	       (push-let-binding rest-name path t))
	      ((eq var '&allow-other-keys)
	       (setq allow-other-keys-p t))
	      ((eq var '&aux)
	       (setq now-processing :auxs))
	      ((listp var)
          (typecase var
            (list
             (case now-processing
               ((:required)
                (when restp
		    (defmacro-error "required argument after &REST/&BODY" error-kind name))  
		  (let ((sub-list-name (gensym "SUBLIST-")))
		    (push-sub-list-binding sub-list-name `(car ,path) var
					   name error-kind error-fun)
		    (parse-defmacro-lambda-list var sub-list-name name
						error-kind error-fun))
                  (defmacro-error "required argument after &REST/&BODY"
                      error-kind name))
                (process-sublist var "SUBLIST-" `(car ,path))
                (setq path `(cdr ,path)
                      minimum (1+ minimum)
                      maximum (1+ maximum)))
@@ -180,11 +147,53 @@
                  (push keyword keys)))
               ((:auxs)
                (push-let-binding (car var) (cadr var) nil))))
	      ((symbolp var)
            ((and symbol (not (eql nil)))
             (case var
               (&whole
                (cond ((cdr rest-of-args)
                       (setq rest-of-args (cdr rest-of-args))
                       (process-sublist (car rest-of-args)
                                        "WHOLE-LIST-" arg-list-name))
                      (t
                       (defmacro-error "&WHOLE" error-kind name))))
               (&environment
                (cond (env-illegal
                       (error "&ENVIRONMENT is not valid with ~S." error-kind))
                      ((not toplevel)
                       (error "&ENVIRONMENT is only valid at top level of ~
                             lambda-list.")))
                (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
                       (setq rest-of-args (cdr rest-of-args))
                       (push-let-binding (car rest-of-args) env-arg-name nil)
                       (setq env-arg-used t))
                      (t
                       (defmacro-error "&ENVIRONMENT" error-kind name))))
               ((&rest &body)
                (cond ((and (not restp) (cdr rest-of-args))
                       (setq rest-of-args (cdr rest-of-args))
                       (setq restp t)
                       (process-sublist (car rest-of-args) "REST-LIST-" path))
                      (t
                       (defmacro-error (symbol-name var) error-kind name))))
               (&optional
                (setq now-processing :optionals))
               (&key
                (setq now-processing :keywords)
                (setq rest-name (gensym "KEYWORDS-"))
                (push rest-name *ignorable-vars*)
                (setq restp t)
                (push-let-binding rest-name path t))
               (&allow-other-keys
                (setq allow-other-keys-p t))
               (&aux
                (setq now-processing :auxs))
               ;; FIXME: Other lambda list keywords.
               (t
                (case now-processing
                  ((:required)
                   (when restp
		    (defmacro-error "required argument after &REST/&BODY" error-kind name))
                     (defmacro-error "required argument after &REST/&BODY"
                         error-kind name))
                   (push-let-binding var `(car ,path) nil)
                   (setq minimum (1+ minimum)
                         maximum (1+ maximum)
@@ -200,9 +209,9 @@
                                       nil)
                     (push key keys)))
                  ((:auxs)
		  (push-let-binding var nil nil))))
                   (push-let-binding var nil nil))))))
            (t
	       (error "non-symbol in lambda-list: ~S" var)))))
             (error "non-symbol in lambda-list: ~S" var))))))
    (let (;; common subexpression, suitable for passing to functions
	  ;; which expect a MAXIMUM argument regardless of whether
	  ;; there actually is a maximum number of arguments
+1 −1
Original line number Diff line number Diff line
@@ -637,7 +637,7 @@
      (collect ((call-args))
	(do ((var arglist (cdr var))
	     (temp temps (cdr temp)))
	    (())
	    ((null var))
	  (let ((info (lambda-var-arg-info (car var))))
	    (if info
		(ecase (arg-info-kind info)
Loading