From 2495ae0b8e527f16d9eba214909ae1a84ca13639 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 7 May 2010 22:20:14 +0200 Subject: [PATCH] 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 | 3 ++- src/cmp/cmpcall.lsp | 6 ------ src/cmp/cmpeval.lsp | 4 +--- src/cmp/cmpglobals.lsp | 3 +++ src/cmp/cmptop.lsp | 11 +++++++++++ src/cmp/cmputil.lsp | 16 +++++++--------- src/lsp/evalmacros.lsp | 2 +- src/new-cmp/cmpcall.lsp | 6 ------ src/new-cmp/cmpeval.lsp | 2 +- src/new-cmp/cmptop.lsp | 10 ++++++++++ 10 files changed, 36 insertions(+), 27 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index d66c7d6c8..428191c83 100755 --- a/src/CHANGELOG +++ b/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. diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp index 52ea50213..a418b8d94 100644 --- a/src/cmp/cmpcall.lsp +++ b/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 diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp index 4cabbc3c2..2ad95220f 100644 --- a/src/cmp/cmpeval.lsp +++ b/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)))) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 981cad9f4..d54dec985 100644 --- a/src/cmp/cmpglobals.lsp +++ b/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) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index edc554a5c..f10c88b06 100644 --- a/src/cmp/cmptop.lsp +++ b/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) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 5ef669957..1e0e044bd 100644 --- a/src/cmp/cmputil.lsp +++ b/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))) diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp index 095d50086..2d108af36 100644 --- a/src/lsp/evalmacros.lsp +++ b/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))) diff --git a/src/new-cmp/cmpcall.lsp b/src/new-cmp/cmpcall.lsp index cc8c4288a..1174f17c4 100644 --- a/src/new-cmp/cmpcall.lsp +++ b/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 diff --git a/src/new-cmp/cmpeval.lsp b/src/new-cmp/cmpeval.lsp index b15cf5c2f..f968297ca 100644 --- a/src/new-cmp/cmpeval.lsp +++ b/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)))) diff --git a/src/new-cmp/cmptop.lsp b/src/new-cmp/cmptop.lsp index dd4708490..eae365f7e 100644 --- a/src/new-cmp/cmptop.lsp +++ b/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