diff --git a/bootfiles/18c/boot5.lisp b/bootfiles/18c/boot5.lisp new file mode 100644 index 0000000000000000000000000000000000000000..ce789c2ca95cb0bde074b90a36362d9962332b63 --- /dev/null +++ b/bootfiles/18c/boot5.lisp @@ -0,0 +1,100 @@ +(in-package "C") + +(defun do-macro-compile-time (name def) + (unless (symbolp name) + (compiler-error "Macro name is not a symbol: ~S." name)) + + (ecase (info function kind name) + ((nil)) + (:function + (remhash name *free-functions*) + (undefine-function-name name) + (compiler-warning + "Defining ~S to be a macro when it was ~(~A~) to be a function." + name (info function where-from name))) + (:macro) + (:special-form + (compiler-error "Attempt to redefine special form ~S as a macro." name))) + + (setf (info function kind name) :macro) + (setf (info function where-from name) :defined) + (when *compile-time-define-macros* + (setf (info function macro-function name) (coerce def 'function)))) + +(def-ir1-translator %defmacro ((name def lambda-list doc) start cont + :kind :function) + (let ((name (eval name)) + (def (second def))) ; Don't want to make a function just yet... + + (let* ((*current-path* (revert-source-path 'defmacro)) + (fun (ir1-convert-lambda def name 'defmacro))) + (setf (leaf-name fun) + (concatenate 'string "DEFMACRO " (symbol-name name))) + (setf (functional-arg-documentation fun) (eval lambda-list)) + + (ir1-convert start cont `(%%defmacro ',name ,fun ,doc))) + + (when *compile-print* + (compiler-mumble "Converted ~S.~%" name)))) + +(defun do-compiler-macro-compile-time (name def) + (when (eq (info function kind name) :special-form) + (compiler-error "Attempt to define a compiler-macro for special form ~S." + name)) + (when *compile-time-define-macros* + (setf (info function compiler-macro-function name) + (coerce def 'function)))) + +(def-ir1-translator %define-compiler-macro ((name def lambda-list doc) + start cont + :kind :function) + (let ((name (eval name)) + (def (second def))) ; Don't want to make a function just yet... + (let* ((*current-path* (revert-source-path 'define-compiler-macro)) + (fun (ir1-convert-lambda def name 'define-compiler-macro))) + (setf (leaf-name fun) + (let ((*print-case* :upcase)) + (format nil "DEFINE-COMPILER-MACRO ~S" name))) + (setf (functional-arg-documentation fun) (eval lambda-list)) + + (ir1-convert start cont `(%%define-compiler-macro ',name ,fun ,doc))) + + (when *compile-print* + (compiler-mumble "Converted ~S.~%" name)))) + +(in-package "LISP") + +(defmacro defmacro (name lambda-list &body body) + (let ((whole (gensym "WHOLE-")) + (environment (gensym "ENV-"))) + (multiple-value-bind + (body local-decs doc) + (parse-defmacro lambda-list whole body name 'defmacro + :environment environment) + (let ((def `(lambda (,whole ,environment) + ,@local-decs + (block ,name + ,body)))) + `(progn + (eval-when (:compile-toplevel) + (c::do-macro-compile-time ',name #',def)) + (eval-when (:load-toplevel :execute) + (c::%defmacro ',name #',def ',lambda-list ,doc))))))) + +(defmacro define-compiler-macro (name lambda-list &body body) + "Define a compiler-macro for NAME." + (let ((whole (gensym "WHOLE-")) + (environment (gensym "ENV-"))) + (multiple-value-bind + (body local-decs doc) + (parse-defmacro lambda-list whole body name 'define-compiler-macro + :environment environment) + (let ((def `(lambda (,whole ,environment) + ,@local-decs + (block ,name + ,body)))) + `(progn + (eval-when (:compile-toplevel) + (c::do-compiler-macro-compile-time ',name #',def)) + (eval-when (:load-toplevel :execute) + (c::%define-compiler-macro ',name #',def ',lambda-list ,doc))))))) diff --git a/code/macros.lisp b/code/macros.lisp index ff0c518abc307495c6f18fe1d2e430f431820c9d..06926e9af593eda181285144764660c2694c83cb 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.68 2001/03/13 16:52:14 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.69 2001/06/03 14:11:16 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -83,7 +83,11 @@ ,@local-decs (block ,name ,body)))) - `(c::%defmacro ',name #',def ',lambda-list ,doc))))) + `(progn + (eval-when (:compile-toplevel) + (c::do-macro-compile-time ',name #',def)) + (eval-when (:load-toplevel :execute) + (c::%defmacro ',name #',def ',lambda-list ,doc))))))) ;;; %Defmacro, %%Defmacro -- Internal @@ -126,7 +130,12 @@ ,@local-decs (block ,name ,body)))) - `(c::%define-compiler-macro ',name #',def ',lambda-list ,doc))))) + `(progn + (eval-when (:compile-toplevel) + (c::do-compiler-macro-compile-time ',name #',def)) + (eval-when (:load-toplevel :execute) + (c::%define-compiler-macro ',name #',def ',lambda-list ,doc))))))) + (defun c::%define-compiler-macro (name definition lambda-list doc) (assert (eval:interpreted-function-p definition)) diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index a0e4ee943d101b954f852be638d0b00637731dce..9212ca92501cd989fd350f986ad33151277c23dd 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.123 2001/03/04 20:12:18 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.124 2001/06/03 14:11:18 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3273,38 +3273,41 @@ ;;; Warn about incompatible or illegal definitions and add the macro to the -;;; compiler environment. +;;; compiler environment. This is split up into compile-time processing and +;;; compilation for load-time effect so that macro definitions, which are split +;;; into :compile-toplevel and (:load-toplevel :execute) parts by the DEFMACRO +;;; macro, will behave properly when not at top level (i.e., no compile time +;;; effect). ;;; ;;; Someday we could check for macro arguments being incompatibly redefined. ;;; Doing this right will involve finding the old macro lambda-list and ;;; comparing it with the new one. ;;; +(defun do-macro-compile-time (name def) + (unless (symbolp name) + (compiler-error "Macro name is not a symbol: ~S." name)) + + (ecase (info function kind name) + ((nil)) + (:function + (remhash name *free-functions*) + (undefine-function-name name) + (compiler-warning + "Defining ~S to be a macro when it was ~(~A~) to be a function." + name (info function where-from name))) + (:macro) + (:special-form + (compiler-error "Attempt to redefine special form ~S as a macro." name))) + + (setf (info function kind name) :macro) + (setf (info function where-from name) :defined) + (when *compile-time-define-macros* + (setf (info function macro-function name) (coerce def 'function)))) + (def-ir1-translator %defmacro ((name def lambda-list doc) start cont :kind :function) (let ((name (eval name)) (def (second def))) ; Don't want to make a function just yet... - (unless (symbolp name) - (compiler-error "Macro name is not a symbol: ~S." name)) - - (ecase (info function kind name) - ((nil)) - (:function - (remhash name *free-functions*) - (undefine-function-name name) - (compiler-warning - "Defining ~S to be a macro when it was ~(~A~) to be a function." - name (info function where-from name))) - (:macro) - (:special-form - (compiler-error "Attempt to redefine special form ~S as a macro." - name))) - - (setf (info function kind name) :macro) - (setf (info function where-from name) :defined) - - (when *compile-time-define-macros* - (setf (info function macro-function name) - (coerce def 'function))) (let* ((*current-path* (revert-source-path 'defmacro)) (fun (ir1-convert-lambda def name 'defmacro))) @@ -3318,20 +3321,19 @@ (compiler-mumble "Converted ~S.~%" name)))) +(defun do-compiler-macro-compile-time (name def) + (when (eq (info function kind name) :special-form) + (compiler-error "Attempt to define a compiler-macro for special form ~S." + name)) + (when *compile-time-define-macros* + (setf (info function compiler-macro-function name) + (coerce def 'function)))) + (def-ir1-translator %define-compiler-macro ((name def lambda-list doc) start cont :kind :function) (let ((name (eval name)) (def (second def))) ; Don't want to make a function just yet... - - (when (eq (info function kind name) :special-form) - (compiler-error "Attempt to define a compiler-macro for special form ~S." - name)) - - (when *compile-time-define-macros* - (setf (info function compiler-macro-function name) - (coerce def 'function))) - (let* ((*current-path* (revert-source-path 'define-compiler-macro)) (fun (ir1-convert-lambda def name 'define-compiler-macro))) (setf (leaf-name fun)