Changeset 11645


Ignore:
Timestamp:
02/08/09 14:34:10 (13 years ago)
Author:
vvoutilainen
Message:

Combine p2-let/let*-vars.

File:
1 edited

Legend:

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

    r11644 r11645  
    142142           (p1-default form)))))
    143143
     144
     145(defmacro p1-let/let*-vars
     146    (varlist variables-var var body1 body2)
     147  (let ((varspec (gensym))
     148  (initform (gensym))
     149  (name (gensym)))
     150    `(let ((,variables-var ()))
     151       (dolist (,varspec ,varlist)
     152   (cond ((consp ,varspec)
     153              ;; FIXME Currently this error is signalled by the precompiler.
     154    (unless (= (length ,varspec) 2)
     155      (compiler-error "The LET/LET* binding specification ~S is invalid."
     156          ,varspec))
     157    (let* ((,name (%car ,varspec))
     158           (,initform (p1 (%cadr ,varspec)))
     159           (,var (make-variable :name (check-name ,name) :initform ,initform)))
     160      (push ,var ,variables-var)
     161      ,@body1))
     162         (t
     163    (let ((,var (make-variable :name (check-name ,varspec))))
     164      (push ,var ,variables-var)
     165      ,@body1))))
     166       ,@body2)))
     167
    144168(defknown p1-let-vars (t) t)
    145169(defun p1-let-vars (varlist)
    146   (let ((vars ()))
    147     (dolist (varspec varlist)
    148       (cond ((consp varspec)
    149               ;; FIXME Currently this error is signalled by the precompiler.
    150              (unless (= (length varspec) 2)
    151                (compiler-error "The LET binding specification ~S is invalid."
    152                                varspec))
    153              (let ((name (check-name (%car varspec)))
    154                    (initform (p1 (%cadr varspec))))
    155                (push (make-variable :name name :initform initform) vars)))
    156             (t
    157              (push (make-variable :name (check-name varspec)) vars))))
    158     (setf vars (nreverse vars))
     170  (p1-let/let*-vars
     171   varlist vars var
     172   ()
     173   ((setf vars (nreverse vars))
    159174    (dolist (variable vars)
    160175      (push variable *visible-variables*)
    161176      (push variable *all-variables*))
    162     vars))
     177    vars)))
    163178
    164179(defknown p1-let*-vars (t) t)
    165180(defun p1-let*-vars (varlist)
    166   (let ((vars ()))
    167     (dolist (varspec varlist)
    168       (cond ((consp varspec)
    169               ;; FIXME Currently this error is signalled by the precompiler.
    170              (unless (= (length varspec) 2)
    171                (compiler-error "The LET* binding specification ~S is invalid."
    172                                varspec))
    173              (let* ((name (%car varspec))
    174                     (initform (p1 (%cadr varspec)))
    175                     (var (make-variable :name (check-name name) :initform initform)))
    176                (push var vars)
    177                (push var *visible-variables*)
    178                (push var *all-variables*)))
    179             (t
    180              (let ((var (make-variable :name (check-name varspec))))
    181                (push var vars)
    182                (push var *visible-variables*)
    183                (push var *all-variables*)))))
    184     (nreverse vars)))
     181  (p1-let/let*-vars
     182   varlist vars var
     183   ((push var *visible-variables*)
     184    (push var *all-variables*))
     185   ((nreverse vars))))
    185186
    186187(defun p1-let/let* (form)
Note: See TracChangeset for help on using the changeset viewer.