Toplevel DEFMACRO forms are processed differently and stored by the compiler in a local table. These definitions do not propagate beyond the currently compiled file.

src/CHANGELOG

@@ -45,7 +45,8 @@ ECL 10.5.1:
  - The compiler is now shipped as a single FASL file, cmp.fas, without
    extra files such as sysfun.lsp
 
- - DECLAIM's proclamation do not propagate beyond the compiled file.
+ - DECLAIM proclamation and toplevel DEFMACRO definitions do not propagate
+   beyond the compiled file.
 
  - AREF/ASET can now be open-coded by the C compiler.
 

src/cmp/cmpcall.lsp

@@ -15,12 +15,6 @@
 
 (in-package "COMPILER")
 
-;;; Like macro-function except it searches the lexical environment,
-;;; to determine if the macro is shadowed by a function or a macro.
-(defun cmp-macro-function (name)
-  (or (cmp-env-search-macro name)
-      (macro-function name)))
-
 (defun unoptimized-long-call (fun arguments)
   (let ((frame (gensym)))
     (c1expr `(with-stack ,frame

src/cmp/cmpeval.lsp

@@ -49,8 +49,6 @@
 (defun c1call-symbol (fname args &aux fd)
   (cond ((setq fd (get-sysprop fname 'c1special)) (funcall fd args))
 	((c1call-local fname args))
-	((setq fd (cmp-env-search-macro fname))
-	 (c1expr (cmp-expand-macro fd (list* fname args))))
 	((and (setq fd (get-sysprop fname 'C1))
 	      (inline-possible fname))
 	 (funcall fd args))
@@ -64,7 +62,7 @@
 		  (cmp-expand-macro fd (list* fname args)))
 		success))
 	 (c1expr fd))
-	((setq fd (macro-function fname))
+	((setq fd (cmp-macro-function fname))
 	 (c1expr (cmp-expand-macro fd (list* fname args))))
 	(t (c1call-global fname args))))
 

src/cmp/cmpglobals.lsp

@@ -285,6 +285,8 @@ lines are inserted, but the order is preserved")
 ;;; *global-entries* holds (... ( fname cfun return-types arg-type ) ...).
 (defvar *global-entries* nil)
 
+(defvar *global-macros* nil)
+
 (defvar *self-destructing-fasl* '()
 "A value T means that, when a FASL module is being unloaded (for
 instance during garbage collection), the associated file will be
@@ -322,6 +324,7 @@ be deleted if they have been opened with LoadLibrary.")
     (*global-vars* nil)
     (*global-funs* nil)
     (*global-cfuns-array* nil)
+    (*global-macros* (make-hash-table :size 64 :test #'eql))
     (*linking-calls* nil)
     (*global-entries* nil)
     (*undefined-vars* nil)

src/cmp/cmptop.lsp

@@ -488,6 +488,16 @@
       (setf form (make-c1form* 'PROGN :args (nconc previous (list form))))))
   form)
 
+(defun t1defmacro (args)
+  (check-args-number 'LOAD-TIME-VALUE args 2)
+  (destructuring-bind (name lambda-list &rest body)
+      args
+    (multiple-value-bind (function pprint doc-string)
+        (sys::expand-defmacro name lambda-list body)
+      (setf (gethash name *global-macros*)
+            (coerce function 'function))
+      (t1expr* (macroexpand `(DEFMACRO ,@args))))))
+
 (defun c1load-time-value (args)
   (check-args-number 'LOAD-TIME-VALUE args 1 2)
   (let ((form (first args))
@@ -799,6 +809,7 @@
 
 ;;; Pass 1 top-levels.
 
+(put-sysprop 'DEFMACRO 'T1 't1defmacro)
 (put-sysprop 'COMPILER-LET 'T1 'c1compiler-let)
 (put-sysprop 'EVAL-WHEN 'T1 'c1eval-when)
 (put-sysprop 'PROGN 'T1 'c1progn)

src/cmp/cmputil.lsp

@@ -302,15 +302,13 @@
               form c)
       nil)))
 
-(defun cmp-macroexpand (form &optional (env *cmp-env*))
-  (handler-case (macroexpand form env)
-    (serious-condition (c)
-      (when *compiler-break-enable*
-        (invoke-debugger c))
-      (cmperr "The macro form ~s was not expanded successfully.~%Error detected:~%~A"
-              form c)
-      nil)))
-  
+;;; Like macro-function except it searches the lexical environment,
+;;; to determine if the macro is shadowed by a function or a macro.
+(defun cmp-macro-function (name)
+  (or (cmp-env-search-macro name)
+      (gethash name *global-macros*)
+      (macro-function name)))
+
 (defun cmp-expand-macro (fd form &optional (env *cmp-env*))
   (handler-case
       (let ((new-form (funcall *macroexpand-hook* fd form env)))

src/lsp/evalmacros.lsp

@@ -41,7 +41,7 @@ last FORM.  If not, simply returns NIL."
     (when *dump-defun-definitions*
       (print function)
       (setq function `(si::bc-disassemble ,function)))
-    `(eval-when (:compile-toplevel :load-toplevel :execute)
+    `(progn
        ,(ext:register-with-pde whole `(si::fset ',name ,function t ,pprint))
        ,@(si::expand-set-documentation name 'function doc-string)
        ',name)))

src/new-cmp/cmpcall.lsp

@@ -15,12 +15,6 @@
 
 (in-package "COMPILER")
 
-;;; Like macro-function except it searches the lexical environment,
-;;; to determine if the macro is shadowed by a function or a macro.
-(defun cmp-macro-function (name)
-  (or (cmp-env-search-macro name)
-      (macro-function name)))
-
 (defun unoptimized-long-call (destination fun arguments)
   (let ((frame (gensym)))
     (c1translate destination

src/new-cmp/cmpeval.lsp

@@ -89,7 +89,7 @@
 		  (cmp-expand-macro fd (list* fname args)))
 		success))
 	 (c1expr destination fd))
-	((setq fd (macro-function fname))
+	((setq fd (cmp-macro-function fname))
 	 (c1expr destination (cmp-expand-macro fd (list* fname args))))
 	(t (c1call-global destination fname args))))
 

src/new-cmp/cmptop.lsp

@@ -185,6 +185,16 @@
 	(cmp-env-register-symbol-macro name (second def))))
     (c1locally destination (cdr args))))
 
+(defun t1defmacro (destination args)
+  (check-args-number 'DEFMACRO args 2)
+  (destructuring-bind (name lambda-list &rest body)
+      args
+    (multiple-value-bind (function pprint doc-string)
+        (sys::expand-defmacro name lambda-list body)
+      (setf (gethash name *global-macros*)
+            (coerce function 'function))
+      (c1locally destination (macroexpand `(DEFMACRO ,@args))))))
+
 ;;; ----------------------------------------------------------------------
 ;;; Optimizer for FSET. Removes the need for a special handling of DEFUN as a
 ;;; toplevel form and also allows optimizing calls to DEFUN or DEFMACRO which