Changeset 12089


Ignore:
Timestamp:
08/08/09 20:43:10 (12 years ago)
Author:
ehuelsmann
Message:

Refer to blocks upon variable creation, wherever appropriate.

File:
1 edited

Legend:

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

    r12087 r12089  
    6161
    6262;; Returns a list of declared free specials, if any are found.
    63 (declaim (ftype (function (list list) list) process-declarations-for-vars))
    64 (defun process-declarations-for-vars (body variables)
     63(declaim (ftype (function (list list block-node) list)
     64                process-declarations-for-vars))
     65(defun process-declarations-for-vars (body variables block)
    6566  (let ((free-specials '()))
    6667    (dolist (subform body)
     
    8586                       (t
    8687                        (dformat t "adding free special ~S~%" name)
    87                         (push (make-variable :name name :special-p t)
     88                        (push (make-variable :name name :special-p t
     89                                             :block block)
    8890                              free-specials))))))
    8991            (TYPE
     
    150152
    151153(defmacro p1-let/let*-vars
    152     (varlist variables-var var body1 body2)
     154    (block varlist variables-var var body1 body2)
    153155  (let ((varspec (gensym))
    154156  (initform (gensym))
     
    166168           (,initform (p1 (%cadr ,varspec)))
    167169           (,var (make-variable :name (check-name ,name)
    168                                             :initform ,initform)))
     170                                            :initform ,initform
     171                                            :block ,block)))
    169172      (push ,var ,variables-var)
    170173      ,@body1))
    171174         (t
    172     (let ((,var (make-variable :name (check-name ,varspec))))
     175    (let ((,var (make-variable :name (check-name ,varspec)
     176                                           :block ,block)))
    173177      (push ,var ,variables-var)
    174178      ,@body1))))
     
    176180
    177181(defknown p1-let-vars (t) t)
    178 (defun p1-let-vars (varlist)
    179   (p1-let/let*-vars
     182(defun p1-let-vars (block varlist)
     183  (p1-let/let*-vars block
    180184   varlist vars var
    181185   ()
     
    187191
    188192(defknown p1-let*-vars (t) t)
    189 (defun p1-let*-vars (varlist)
    190   (p1-let/let*-vars
     193(defun p1-let*-vars (block varlist)
     194  (p1-let/let*-vars block
    191195   varlist vars var
    192196   ((push var *visible-variables*)
     
    213217                (return)))))
    214218    (let ((vars (if (eq op 'LET)
    215                     (p1-let-vars varlist)
    216                     (p1-let*-vars varlist))))
     219                    (p1-let-vars block varlist)
     220                    (p1-let*-vars block varlist))))
    217221      ;; Check for globally declared specials.
    218222      (dolist (variable vars)
     
    224228      ;; with the specified name.
    225229      (setf (block-free-specials block)
    226             (process-declarations-for-vars body (reverse vars)))
     230            (process-declarations-for-vars body (reverse vars) block))
    227231      (setf (block-vars block) vars)
    228232      ;; Make free specials visible.
     
    236240  (let* ((*visible-variables* *visible-variables*)
    237241         (block (make-block-node '(LOCALLY)))
    238          (free-specials (process-declarations-for-vars (cdr form) nil)))
     242         (free-specials (process-declarations-for-vars (cdr form) nil block)))
    239243    (setf (block-free-specials block) free-specials)
    240244    (dolist (special free-specials)
     
    262266    (let ((vars ()))
    263267      (dolist (symbol varlist)
    264         (let ((var (make-variable :name symbol)))
     268        (let ((var (make-variable :name symbol :block block)))
    265269          (push var vars)
    266270          (push var *visible-variables*)
     
    272276                (block-environment-register block) t)))
    273277      (setf (block-free-specials block)
    274             (process-declarations-for-vars body vars))
     278            (process-declarations-for-vars body vars block))
    275279      (dolist (special (block-free-specials block))
    276280        (push special *visible-variables*))
     
    643647                (*visible-variables* *visible-variables*))
    644648           (setf (block-free-specials block)
    645                  (process-declarations-for-vars body nil))
     649                 (process-declarations-for-vars body nil block))
    646650           (dolist (special (block-free-specials block))
    647651             (push special *visible-variables*))
     
    673677              (*visible-variables* *visible-variables*))
    674678         (setf (block-free-specials block)
    675                (process-declarations-for-vars body nil))
     679               (process-declarations-for-vars body nil block))
    676680         (dolist (special (block-free-specials block))
    677681           (push special *visible-variables*))
     
    771775  ;; We've already checked argument count in PRECOMPILE-PROGV.
    772776
    773   ;; ### FIXME: we need to return a block here, so that
    774   ;;  (local) GO in p2 can restore the lastSpecialBinding environment
    775777  (let ((new-form (rewrite-progv form)))
    776778    (when (neq new-form form)
     
    781783         (*blocks* (cons block *blocks*))
    782784         (body (cdddr form)))
     785;;  The (commented out) block below means to detect compile-time
     786;;  enumeration of bindings to be created (a quoted form in the symbols
     787;;  position).
     788;;    (when (and (quoted-form-p symbols-form)
     789;;               (listp (second symbols-form)))
     790;;      (dolist (name (second symbols-form))
     791;;        (let ((variable (make-variable :name name :special-p t)))
     792;;          (push
    783793    (setf (block-form block)
    784794          `(progv ,symbols-form ,values-form ,@(p1-body body))
     
    11101120          (push var *visible-variables*)))
    11111121      (setf (compiland-arg-vars compiland) (nreverse vars))
    1112       (let ((free-specials (process-declarations-for-vars body vars)))
     1122      (let ((free-specials (process-declarations-for-vars body vars nil)))
    11131123        (setf (compiland-free-specials compiland) free-specials)
    11141124        (dolist (var free-specials)
Note: See TracChangeset for help on using the changeset viewer.