Changeset 11712


Ignore:
Timestamp:
03/15/09 22:58:12 (13 years ago)
Author:
ehuelsmann
Message:

Fix special binding issue related to arguments declared special.

Found by: Don Cohen (don-sourceforge-xxz at isis.cs3-inc.com)

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

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r11645 r11712  
    933933             (vars nil))
    934934        (dolist (sym syms)
    935           (let ((var (make-variable :name sym)))
     935          (let ((var (make-variable :name sym
     936                                    :special-p (special-variable-p sym))))
    936937            (push var vars)
    937938            (push var *all-variables*)))
  • trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

    r11695 r11712  
    607607    (multiple-value-bind (body decls doc)
    608608        (parse-body (cddr form))
    609       (let* ((declared-specials (process-special-declarations decls))
    610              (specials nil))
    611         ;; Scan for specials.
    612         (let ((keyp nil))
    613           (dolist (var lambda-list)
    614             (cond ((eq var '&KEY)
    615                    (setq keyp t))
    616                   ((atom var)
    617                    (when (or (special-variable-p var) (memq var declared-specials))
    618                      (push var specials)))
    619                   ((not keyp) ;; e.g. "&optional (*x* 42)"
    620                    (setq var (%car var))
    621                    (when (or (special-variable-p var) (memq var declared-specials))
    622                      (push var specials)))
    623                   ;; Keyword parameters.
    624                   ((atom (%car var)) ;; e.g. "&key (a 42)"
    625                    ;; Not special.
    626                    )
    627                   (t
    628                    ;; e.g. "&key ((:x *x*) 42)"
    629                    (setq var (second (%car var))) ;; *x*
    630                    (when (or (special-variable-p var) (memq var declared-specials))
    631                      (push var specials))))))
    632         ;;//###FIXME: Ideally, we don't rewrite for specials at all
    633         (when specials
    634           ;; For each special...
    635           (dolist (special specials)
    636             (let ((sym special))
    637               (let ((res nil)
    638                     (keyp nil))
    639                 ;; Walk through the lambda list and replace each occurrence.
    640                 (dolist (var lambda-list)
    641                   (cond ((eq var '&KEY)
    642                          (setq keyp t)
    643                          (push var res))
    644                         ((atom var)
    645                          (when (eq var special)
    646                            (setq var sym))
    647                          (push var res))
    648                         ((not keyp) ;; e.g. "&optional (*x* 42)"
    649                          (when (eq (%car var) special)
    650                            (setf (car var) sym))
    651                          (push var res))
    652                         ((atom (%car var)) ;; e.g. "&key (a 42)"
    653                          (push var res))
    654                         (t
    655                          ;; e.g. "&key ((:x *x*) 42)"
    656                          (when (eq (second (%car var)) special)
    657                            (setf (second (%car var)) sym))
    658                          (push var res))))
    659                 (setq lambda-list (nreverse res)))
    660               (setq body (list (append (list 'LET* (list (list special sym))) body))))))
    661         `(lambda ,lambda-list ,@decls ,@(when doc `(,doc)) ,@body)))))
     609        `(lambda ,lambda-list ,@decls ,@(when doc `(,doc)) ,@body))))
    662610
    663611(defun precompile-lambda (form)
Note: See TracChangeset for help on using the changeset viewer.