Changeset 11799


Ignore:
Timestamp:
04/29/09 20:50:07 (15 years ago)
Author:
ehuelsmann
Message:

Check LET/LET* and &AUX bindings validity.

Also fixes an incorrectly placed paren in clos.lisp
found as a result.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r11590 r11799  
    17381738  (let* ((lambda-expression
    17391739          (if (eq (class-of class) (find-class 'standard-class))
    1740               `(lambda (object) (std-slot-value object ',slot-name)))
    1741               `(lambda (object) (slot-value object ',slot-name)))
     1740              `(lambda (object) (std-slot-value object ',slot-name))
     1741              `(lambda (object) (slot-value object ',slot-name))))
    17421742         (method-function (compute-method-function lambda-expression))
    17431743         (fast-function (compute-method-fast-function lambda-expression)))
  • trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

    r11797 r11799  
    655655
    656656(defun precompile-lambda-list (form)
    657   (let (new)
     657  (let (new aux-tail)
    658658    (dolist (arg form (nreverse new))
    659659       (if (or (atom arg) (> 2 (length arg)))
    660           (push arg new)
     660           (progn
     661             (when (eq arg '&aux)
     662               (setf aux-tail t))
     663             (push arg new))
    661664          ;; must be a cons of more than 1 cell
    662665          (let ((new-arg (copy-list arg)))
     666            (unless (<= 1 (length arg) (if aux-tail 2 3))
     667              ;; the aux-vars have a maximum length of 2 conses
     668              ;; optional and key vars may have 3
     669              (error 'program-error
     670                     :format-control
     671                     "The ~A binding specification ~S is invalid."
     672                     :format-arguments (list (if aux-tail "&AUX"
     673                                                 "&OPTIONAL/&KEY") arg)))
    663674             (setf (second new-arg)
    664675                   (precompile1 (second arg)))
     
    757768    (dolist (var vars)
    758769      (cond ((consp var)
    759 ;;              (when (> (length var) 2)
    760 ;;                (error 'program-error
    761 ;;                       :format-control "The LET/LET* binding specification ~S is invalid."
    762 ;;                       :format-arguments (list var)))
     770             (unless (<= 1 (length var) 2)
     771               (error 'program-error
     772                       :format-control
     773                       "The LET/LET* binding specification ~S is invalid."
     774                       :format-arguments (list var)))
    763775             (let ((v (%car var))
    764776                   (expr (cadr var)))
Note: See TracChangeset for help on using the changeset viewer.