From c6f456356fb8899efa02b2a74a23e653fef3e57d Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sat, 5 Oct 2002 05:59:27 +0000 Subject: [PATCH] 0.7.8.16: DEFMACRO is implemented via EVAL-WHEN ... removed IR1 translator of %DEFMACRO ... removed %%DEFMACRO; its functionality is moved into %DEFMACRO --- NEWS | 2 + src/code/defmacro.lisp | 96 ++++++++++++++++++++++++------------- src/code/early-fasl.lisp | 4 +- src/compiler/ir1-translators.lisp | 83 ++------------------------------ src/compiler/ltn.lisp | 5 +- src/compiler/meta-vmdef.lisp | 10 ++-- tests/compiler.impure.lisp | 22 +++++++++ tests/defmacro-test.lisp | 15 ++++++ version.lisp-expr | 2 +- 9 files changed, 117 insertions(+), 122 deletions(-) create mode 100644 tests/defmacro-test.lisp diff --git a/NEWS b/NEWS index 5eab745..0f6fbe3 100644 --- a/NEWS +++ b/NEWS @@ -1315,6 +1315,8 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8: Gerd Moellman's work in CMU CL) * fixed bug 202: The compiler no longer fails on functions whose derived types contradict their declared type. + * DEFMACRO is implemented via EVAL-WHEN instead of IR1 translation, + so it can be non-toplevel. planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp index adb9d35..adce1a7 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -12,12 +12,17 @@ (in-package "SB!IMPL") ;;; the guts of the DEFMACRO macro, pulled out into a separate -;;; function in order to make it easier to express the common +;;; function in order to make it easier to express the common ;;; bootstrap idiom ;;; CL:DEFMACRO SB!XC:DEFMACRO ;;; SB!XC:DEFMACRO CL:DEFMACRO (eval-when (:compile-toplevel :load-toplevel :execute) (defun %expander-for-defmacro (name lambda-list body) + (unless (symbolp name) + (error "The macro name ~S is not a symbol." name)) + (when (special-operator-p name) + (error "The special operator ~S can't be redefined as a macro." + name)) (let ((whole (gensym "WHOLE-")) (environment (gensym "ENV-"))) (multiple-value-bind (new-body local-decs doc) @@ -27,42 +32,65 @@ ,@local-decs (block ,name ,new-body)))) - `(sb!c::%defmacro ',name #',def ',lambda-list ,doc)))))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (sb!c::%defmacro ',name #',def ',lambda-list ,doc))))))) -;;; Ordinarily this definition of SB!C:%DEFMACRO as an ordinary -;;; function is not used: the parallel (but different) definition as -;;; an IR1 transform takes precedence. However, this definition is -;;; still useful in the target interpreter, and in the -;;; cross-compilation host. -(defun sb!c::%defmacro (name definition lambda-list doc) - (declare (ignore lambda-list)) - (sb!c::%%defmacro name definition doc)) - -;;; (called by SB!C::%DEFMACRO) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun sb!c::%%defmacro (name definition doc) - ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO should - ;; deal with clearing old compiler information for the functional - ;; value." - (clear-info :function :where-from name) - ;; FIXME: It would be nice to warn about DEFMACRO of an - ;; already-defined macro, but that's slightly hard to do because - ;; in common usage DEFMACRO is defined at compile time and then - ;; redefined at load time. We'd need to make a distinction between - ;; the defined-at-compile-time state and the defined-at-load-time - ;; state to make this work. (Trying to warn about duplicate - ;; DEFTYPEs runs into the same problem.) - #+nil (when (sb!xc:macro-function name) - (style-warn "redefining ~S in DEFMACRO" name)) - (setf (sb!xc:macro-function name) definition - (fdocumentation name 'function) doc) - name)) +(macrolet + ((def (times set-args-p) + `(eval-when (,@times) + (defun sb!c::%defmacro (name definition lambda-list doc) + ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO + ;; should deal with clearing old compiler information for + ;; the functional value." + (ecase (info :function :kind name) + ((nil)) + (:function + ;; (remhash name *free-funs*) + (undefine-fun-name name) + (style-warn + "~S is being redefined as a macro when it was ~ + previously ~(~A~) to be a function." + name + (info :function :where-from name))) + (:macro) + (:special-form + (error "The special form ~S can't be redefined as a macro." + name))) + (clear-info :function :where-from name) + ;; FIXME: It would be nice to warn about DEFMACRO of an + ;; already-defined macro, but that's slightly hard to do + ;; because in common usage DEFMACRO is defined at compile + ;; time and then redefined at load time. We'd need to make a + ;; distinction between the defined-at-compile-time state and + ;; the defined-at-load-time state to make this work. (Trying + ;; to warn about duplicate DEFTYPEs runs into the same + ;; problem.) + #+nil (when (sb!xc:macro-function name) + ;; 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. + (style-warn "redefining ~S in DEFMACRO" name)) + (setf (sb!xc:macro-function name) definition + (fdocumentation name 'function) doc) + ,(when set-args-p + `(case (widetag-of definition) + (#.sb!vm:closure-header-widetag + (setf (%simple-fun-arglist (%closure-fun definition)) + lambda-list)) + ((#.sb-vm:simple-fun-header-widetag + #.sb-vm:closure-fun-header-widetag) + (setf (%simple-fun-arglist definition) lambda-list)))) + name)))) + (progn + (def (:load-toplevel :execute) #-sb-xc-host t #+sb-xc-host nil) + (def (:compile-toplevel) nil))) ;;; Parse the definition and make an expander function. The actual -;;; definition is done by %DEFMACRO which we expand into, and which is -;;; handled magically by an IR1 transform. After the compiler has -;;; gotten the information it wants out of macro definition, it -;;; compiles a call to %%DEFMACRO which happens at load time. +;;; definition is done by %DEFMACRO which we expand into. After the +;;; compiler has gotten the information it wants out of macro +;;; definition, it compiles a call to %DEFMACRO which happens at load +;;; time. (defmacro sb!xc:defmacro (name lambda-list &rest body) (%expander-for-defmacro name lambda-list body)) diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 34798cd..c3c7046 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -42,7 +42,7 @@ ;;; versions which break binary compatibility. But it certainly should ;;; be incremented for release versions which break binary ;;; compatibility. -(def!constant +fasl-file-version+ 33) +(def!constant +fasl-file-version+ 34) ;;; (record of versions before 0.7.0 deleted in 0.7.1.41) ;;; 23 = sbcl-0.7.0.1 deleted no-longer-used EVAL-STACK stuff, ;;; causing changes in *STATIC-SYMBOLS*. @@ -65,6 +65,8 @@ ;;; causing old utility functions like COERCE-TO-SIMPLE-VECTOR to go away ;;; 33: (2002-10-02) (again) changes in implementation of sequence functions, ;;; causing old utility functions like COERCE-TO-SIMPLE-VECTOR to go away +;;; 34: (2002-10-05) changed implementation of DEFMACRO, so %%DEFMACRO +;;; was deleted ;;; the conventional file extension for our fasl files (declaim (type simple-string *fasl-file-type*)) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 8c11111..eb15d0c 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -77,7 +77,7 @@ (setf (entry-cleanup entry) cleanup) (link-node-to-previous-continuation entry start) (use-continuation entry dummy) - + (let* ((env-entry (list entry cont)) (*lexenv* (make-lexenv :blocks (list (cons name env-entry)) :cleanup cleanup))) @@ -177,7 +177,7 @@ (starts dummy) (dolist (segment (rest segments)) (let* ((tag-cont (make-continuation)) - (tag (list (car segment) entry tag-cont))) + (tag (list (car segment) entry tag-cont))) (conts tag-cont) (starts tag-cont) (continuation-starts-block tag-cont) @@ -222,7 +222,7 @@ ;;; are ignored for non-top-level forms. For non-top-level forms, an ;;; eval-when specifying the :EXECUTE situation is treated as an ;;; implicit PROGN including the forms in the body of the EVAL-WHEN -;;; form; otherwise, the forms in the body are ignored. +;;; form; otherwise, the forms in the body are ignored. (def-ir1-translator eval-when ((situations &rest forms) start cont) #!+sb-doc "EVAL-WHEN (Situation*) Form* @@ -309,7 +309,7 @@ :vars definitions fun)) - + (def-ir1-translator symbol-macrolet ((macrobindings &body body) start cont) #!+sb-doc "SYMBOL-MACROLET ({(Name Expansion)}*) Decl* Form* @@ -1049,79 +1049,6 @@ (eq first 'original-source-start)) (return path))))) -;;; Warn about incompatible or illegal definitions and add the macro -;;; to the compiler environment. -;;; -;;; 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. -(def-ir1-translator %defmacro ((qname qdef lambda-list doc) start cont - :kind :function) - (let (;; QNAME is typically a quoted name. I think the idea is to - ;; let %DEFMACRO work as an ordinary function when - ;; interpreting. Whatever the reason the quote is there, we - ;; don't want it any more. -- WHN 19990603 - (name (eval qname)) - ;; QDEF should be a sharp-quoted definition. We don't want to - ;; make a function of it just yet, so we just drop the - ;; sharp-quote. - (def (progn - (aver (eq 'function (first qdef))) - (aver (proper-list-of-length-p qdef 2)) - (second qdef)))) - - (/show "doing IR1 translator for %DEFMACRO" name) - - (unless (symbolp name) - (compiler-error "The macro name ~S is not a symbol." name)) - - (ecase (info :function :kind name) - ((nil)) - (:function - (remhash name *free-funs*) - (undefine-fun-name name) - (compiler-warn - "~S is being redefined as a macro when it was ~ - previously ~(~A~) to be a function." - name - (info :function :where-from name))) - (:macro) - (:special-form - (compiler-error "The special form ~S can't be redefined as a macro." - name))) - - (setf (info :function :kind name) :macro - (info :function :where-from name) :defined - (info :function :macro-function name) (coerce def 'function)) - - (let* ((*current-path* (revert-source-path 'defmacro)) - (fun (ir1-convert-lambda def - :debug-name (debug-namify "DEFMACRO ~S" - name)))) - (setf (functional-arg-documentation fun) (eval lambda-list)) - - (ir1-convert start cont `(%%defmacro ',name ,fun ,doc))) - - (when sb!xc:*compile-print* - ;; FIXME: It would be nice to convert this, and the other places - ;; which create compiler diagnostic output prefixed by - ;; semicolons, to use some common utility which automatically - ;; prefixes all its output with semicolons. (The addition of - ;; semicolon prefixes was introduced ca. sbcl-0.6.8.10 as the - ;; "MNA compiler message patch", and implemented by modifying a - ;; bunch of output statements on a case-by-case basis, which - ;; seems unnecessarily error-prone and unclear, scattering - ;; implicit information about output style throughout the - ;; system.) Starting by rewriting COMPILER-MUMBLE to add - ;; semicolon prefixes would be a good start, and perhaps also: - ;; * Add semicolon prefixes for "FOO assembled" messages emitted - ;; when e.g. src/assembly/x86/assem-rtns.lisp is processed. - ;; * At least some debugger output messages deserve semicolon - ;; prefixes too: - ;; ** restarts table - ;; ** "Within the debugger, you can type HELP for help." - (compiler-mumble "~&; converted ~S~%" name)))) - (def-ir1-translator %define-compiler-macro ((name def lambda-list doc) start cont :kind :function) @@ -1136,7 +1063,7 @@ (coerce def 'function)) (let* ((*current-path* (revert-source-path 'define-compiler-macro)) - (fun (ir1-convert-lambda def + (fun (ir1-convert-lambda def :debug-name (debug-namify "DEFINE-COMPILER-MACRO ~S" name)))) diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp index d365a4f..7e9171b 100644 --- a/src/compiler/ltn.lisp +++ b/src/compiler/ltn.lisp @@ -412,8 +412,7 @@ ;;; Make sure that a tail local call is linked directly to the bind ;;; node. Usually it will be, but calls from XEPs and calls that might have ;;; needed a cleanup after them won't have been swung over yet, since we -;;; weren't sure they would really be TR until now. Also called by byte -;;; compiler. +;;; weren't sure they would really be TR until now. (defun set-tail-local-call-successor (call) (let ((caller (node-home-lambda call)) (callee (combination-lambda call))) @@ -823,7 +822,7 @@ ;;; unsafe, then we never do any checks. If our policy is safe, and ;;; we are using a safe template, then we can also flush arg and ;;; result type checks. Result type checks are only flushed when the -;;; continuation as a single use. Result type checks are not flush if +;;; continuation has a single use. Result type checks are not flush if ;;; the policy is safe because the selection of template for results ;;; readers assumes the type check is done (uses the derived type ;;; which is the intersection of the proven and asserted types). diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 7d5b1bb..b44b9ab 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -1504,11 +1504,11 @@ ;;; are defaulted from the inherited argument (or result) of the same ;;; name. The following operand options are defined: ;;; -;;; :SCs (SC*) -;;; :SCs specifies good SCs for this operand. Other SCs will be -;;; penalized according to move costs. A load TN will be allocated if -;;; necessary, guaranteeing that the operand is always one of the -;;; specified SCs. +;;; :SCs (SC*) +;;; :SCs specifies good SCs for this operand. Other SCs will +;;; be penalized according to move costs. A load TN will be +;;; allocated if necessary, guaranteeing that the operand is +;;; always one of the specified SCs. ;;; ;;; :LOAD-TN Load-Name ;;; Load-Name is bound to the load TN allocated for this diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 294bfc8..a9dd138 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -439,6 +439,28 @@ BUG 48c, not yet fixed: (declare (type (and function (satisfies bug199-aux)) f)) (funcall f x)) +;;; check non-toplevel DEFMACRO +(defvar *defmacro-test-status* nil) + +(defun defmacro-test () + (fmakunbound 'defmacro-test-aux) + (let* ((src "defmacro-test.lisp") + (obj (compile-file-pathname src))) + (unwind-protect + (progn + (compile-file src) + (assert (equal *defmacro-test-status* '(function a))) + (setq *defmacro-test-status* nil) + (load obj) + (assert (equal *defmacro-test-status* nil)) + (macroexpand '(defmacro-test-aux 'a)) + (assert (equal *defmacro-test-status* '(macro 'a z-value))) + (eval '(defmacro-test-aux 'a)) + (assert (equal *defmacro-test-status* '(expanded 'a z-value)))) + (ignore-errors (delete-file obj))))) + +(defmacro-test) + ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/tests/defmacro-test.lisp b/tests/defmacro-test.lisp new file mode 100644 index 0000000..be951e6 --- /dev/null +++ b/tests/defmacro-test.lisp @@ -0,0 +1,15 @@ +;;;; Test of non-toplevel DEFMACRO +(cl:in-package :cl-user) + +(eval-when (:compile-toplevel) + (defun defmacro-test-aux (x) + (setq *defmacro-test-status* `(function ,x)) + nil)) + +(let ((z 'z-value)) + (defmacro defmacro-test-aux (x) + (setq *defmacro-test-status* `(macro ,x ,z)) + `(setq *defmacro-test-status* '(expanded ,x ,z)))) + +(eval-when (:compile-toplevel) + (defmacro-test-aux 'a)) diff --git a/version.lisp-expr b/version.lisp-expr index 6467974..04f77c7 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.15" +"0.7.8.16" -- 1.7.10.4