Changeset 859

Timestamp:

Aug 10, 2004, 5:54:24 PM (20 years ago)

Author:

Gary Byers

Message:

Check for local macro functions (and complain if FUNCTION references them)
in cheap evaluator.

Pass a function and other information to *MACROEXPAND-HOOK* when expanding
symbol-macros.

File:

• trunk/ccl/level-1/l1-readloop.lisp (modified) (3 diffs)

trunk/ccl/level-1/l1-readloop.lisp

@@ -212 +212 @@
 
 (defun %symbol-macroexpand-1 (sym env)
-  (if (and env (not (istruct-typep env 'lexical-environment)))
+  (flet ((expand-it (expansion)
+           (funcall *macroexpand-hook*
+                    (constantly expansion)
+                    sym
+                    env)))
+    (if (and env (not (istruct-typep env 'lexical-environment)))
       (report-bad-arg env 'lexical-environment))
-  (do* ((env env (lexenv.parent-env env)))
-       ((null env))
-    (if (eq (%svref env 0) 'definition-environment)
+    (do* ((env env (lexenv.parent-env env)))
+         ((null env))
+      (if (eq (%svref env 0) 'definition-environment)
         (let* ((info (assq sym (defenv.symbol-macros env))))
           (if info
-            (return-from %symbol-macroexpand-1 (values (cdr info) t))
+            (return-from %symbol-macroexpand-1 (values (expand-it (cdr info)) t))
             (return)))
         (let* ((vars (lexenv.variables env)))
@@ -225 +230 @@
             (let* ((info (dolist (var vars)
                            (if (eq (var-name var) sym)
-                               (return var)))))            
+                             (return var)))))            
               (when info
                 (if (and (consp (setq info (var-expansion info)))
                          (eq (%car info) :symbol-macro))
-                    (return-from %symbol-macroexpand-1 (values (%cdr info) t))
-                    (return-from %symbol-macroexpand-1 (values sym nil)))))))))
-  ;; Look it up globally.
-  (multiple-value-bind (expansion win) (gethash sym *symbol-macros*)
-    (if win (values expansion t) (values sym nil))))
+                  (return-from %symbol-macroexpand-1 (values (expand-it (%cdr info)) t))
+                  (return-from %symbol-macroexpand-1 (values sym nil)))))))))
+    ;; Look it up globally.
+    (multiple-value-bind (expansion win) (gethash sym *symbol-macros*)
+      (if win (values (expand-it expansion) t) (values sym nil)))))
 
 (defun macroexpand-1 (form &optional env &aux fn)
@@ -357 +362 @@
              (verify-arg-count form 1 1)
              (cond ((symbolp (setq sym (%cadr form)))
+                    (multiple-value-bind (kind local-p)
+                        (function-information sym env)
+                      (if (and local-p (eq kind :macro))
+                        (error "~s can't be used to reference lexically defined macro ~S" 'function sym)))
                     (%function sym))
                    ((and (consp sym) (eq (%car sym) 'setf) (consp (%cdr sym)) (null (%cddr sym)))
+                    (multiple-value-bind (kind local-p)
+                        (function-information sym env)
+                      (if (and local-p (eq kind :macro))
+                        (error "~s can't be used to reference lexically defined macro ~S" 'function sym)))
                     (%function (setf-function-name (%cadr sym))))
                    (t (%make-function nil sym env))))