Changeset 11915

Timestamp:

05/21/09 17:14:40 (14 years ago)

Author:

ehuelsmann

Message:

Reuse available infrastructure in Environment,
instead of keeping track of locals (and their
shadowing effect) ourselves.

File:

• trunk/abcl/src/org/armedbear/lisp/precompiler.lisp (modified) (10 diffs)

trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

@@ -257 +257 @@
              (symbolp (cadr callee))
              (not (special-operator-p (cadr callee)))
-             (not (macro-function (cadr callee) sys:*compile-file-environment*))
+             (not (macro-function (cadr callee) *compile-file-environment*))
              (memq (symbol-package (cadr callee))
                    (list (find-package "CL") (find-package "SYS"))))
@@ -356 +356 @@
 (defvar *in-jvm-compile* nil)
 
-(defvar *local-variables* nil
-  "An alist with all local variables visible in the context
-of the form being preprocessed.")
-
-(declaim (ftype (function (t) t) find-varspec))
-(defun find-varspec (sym)
-  (dolist (varspec *local-variables*)
-    (when (eq sym (car varspec))
-      (return varspec))))
-
 (declaim (ftype (function (t) t) precompile1))
 (defun precompile1 (form)
   (cond ((symbolp form)
-         (let ((varspec (find-varspec form)))
-           (cond ((and varspec (eq (second varspec) :symbol-macro))
-                  (precompile1 (copy-tree (third varspec))))
-                 ((null varspec)
-                  (let ((expansion (expand-macro form)))
-                    (if (eq expansion form)
-                        form
-                        (precompile1 expansion))))
-                 (t
-                  form))))
+         (multiple-value-bind
+               (expansion expanded)
+             (expand-macro form)
+           (if expanded
+               (precompile1 expansion)
+               form)))
         ((atom form)
          form)
@@ -518 +504 @@
      (precompile1 (expand-macro form)))
     ((symbolp place)
-           (let ((varspec (find-varspec place)))
-             (if (and varspec (eq (second varspec) :symbol-macro))
-                 (precompile1 (list* 'SETF (copy-tree (third varspec)) (cddr form)))
+           (multiple-value-bind
+                 (expansion expanded)
+               (expand-macro place)
+             (if expanded
+                 (precompile1 (list* 'SETF expansion
+                                     (cddr form)))
                  (precompile1 (expand-macro form)))))
           (t
@@ -533 +522 @@
     (if (= len 2)
         (let* ((sym (%car args))
-               (val (%cadr args))
-               (varspec (find-varspec sym)))
-          (if (and varspec (eq (second varspec) :symbol-macro))
-              (precompile1 (list 'SETF (copy-tree (third varspec)) val))
-              (list 'SETQ sym (precompile1 val))))
+               (val (%cadr args)))
+          (multiple-value-bind
+                (expansion expanded)
+              (expand-macro sym)
+            (if expanded
+                (precompile1 (list 'SETF expansion val))
+                (list 'SETQ sym (precompile1 val))
+                )))
         (let ((result ()))
           (loop
@@ -629 +621 @@
 
 (defun precompile-symbol-macrolet (form)
-  (let ((*local-variables* *local-variables*)
-        (*compile-file-environment*
+  (let ((*compile-file-environment*
          (make-environment *compile-file-environment*))
         (defs (cadr form)))
@@ -640 +631 @@
                  :format-control "Attempt to bind the special variable ~S with SYMBOL-MACROLET."
                  :format-arguments (list sym)))
-        (push (list sym :symbol-macro expansion) *local-variables*)
         (environment-add-symbol-binding *compile-file-environment*
                                         sym
@@ -689 +679 @@
                         :format-arguments (list v)))
                (push (list v (precompile1 expr)) result)
-               (push (list v :variable) *local-variables*)))
+               (environment-add-symbol-binding *compile-file-environment*
+                                               v nil))) ;; any value will do
             (t
              (push var result)
-             (push (list var :variable) *local-variables*))))
+             (environment-add-symbol-binding *compile-file-environment*
+                                             var nil)
+)))
     (nreverse result)))
 
 (defun precompile-let (form)
-  (let ((*local-variables* *local-variables*))
+  (let ((*compile-file-environment*
+         (make-environment *compile-file-environment*)))
     (list* 'LET
            (precompile-let/let*-vars (cadr form))
@@ -713 +707 @@
 (defun precompile-let* (form)
   (setf form (maybe-fold-let* form))
-  (let ((*local-variables* *local-variables*))
+  (let ((*compile-file-environment*
+         (make-environment *compile-file-environment*)))
     (list* 'LET*
            (precompile-let/let*-vars (cadr form))
@@ -857 +852 @@
         (values-form (caddr form))
         (body (cdddr form))
-        (*local-variables* *local-variables*))
+        (*compile-file-environment*
+         (make-environment *compile-file-environment*))
+)
     (dolist (var vars)
-      (push (list var :variable) *local-variables*))
+      (environment-add-symbol-binding *compile-file-environment* var nil))
     (list* 'MULTIPLE-VALUE-BIND
            vars
@@ -915 +912 @@
 ;; operator, so interpreted code can use the special operator implementation.
 (defun expand-macro (form)
-  (loop
-    (unless *in-jvm-compile*
-      (when (and (consp form)
-                 (symbolp (%car form))
-                 (special-operator-p (%car form)))
-        (return-from expand-macro form)))
-    (multiple-value-bind (result expanded)
-        (macroexpand-1 form *compile-file-environment*)
-      (unless expanded
-        (return-from expand-macro result))
-      (setf form result))))
+  (let (exp)
+    (loop
+       (unless *in-jvm-compile*
+         (when (and (consp form)
+                    (symbolp (%car form))
+                    (special-operator-p (%car form)))
+           (return-from expand-macro form)))
+       (multiple-value-bind (result expanded)
+           (macroexpand-1 form *compile-file-environment*)
+         (unless expanded
+           (return-from expand-macro (values result exp)))
+         (setf form result
+               exp t)))))
 
 (declaim (ftype (function (t t) t) precompile-form))