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
(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)
,@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))
;;; 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*.
;;; 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*))
(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)))
(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)
;;; 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*
:vars
definitions
fun))
-
+
(def-ir1-translator symbol-macrolet ((macrobindings &body body) start cont)
#!+sb-doc
"SYMBOL-MACROLET ({(Name Expansion)}*) Decl* Form*
(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)
(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))))
;;; 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)))
;;; 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).
;;; 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
(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)
+
\f
;;;; tests not in the problem domain, but of the consistency of the
;;;; compiler machinery itself
--- /dev/null
+;;;; 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))
;;; 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"
projects / sbcl.git / commitdiff