X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Fmacros.lisp;h=5ee726a7434809d448789f3a8f5fadc0c4ff2e35;hb=86210c4e406c1b2ff10cc3bac0e71435867db48b;hp=1976274b81a33aecb10089bad802ee98c1cb51ef;hpb=0a82f2db352cc348d2107a882e50af222ff97ed3;p=sbcl.git

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 1976274..5ee726a 100644
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -31,8 +31,8 @@
    some locations known to SETF, starting over with test-form. Returns NIL."
   `(do () (,test-form)
      (assert-error ',test-form ',places ,datum ,@arguments)
-     ,@(mapcar #'(lambda (place)
-		   `(setf ,place (assert-prompt ',place ,place)))
+     ,@(mapcar (lambda (place)
+		 `(setf ,place (assert-prompt ',place ,place)))
 	       places)))
 
 (defun assert-prompt (name value)
@@ -91,7 +91,7 @@
 (defun sb!c::%defconstant (name value doc)
   (unless (symbolp name)
     (error "The constant name is not a symbol: ~S" name))
-  (about-to-modify name)
+  (about-to-modify-symbol-value name)
   (when (looks-like-name-of-special-var-p name)
     (style-warn "defining ~S as a constant, even though the name follows~@
 the usual naming convention (names like *FOO*) for special variables"
@@ -105,8 +105,8 @@ the usual naming convention (names like *FOO*) for special variables"
        ;; want bindings which are constant in some sense other than
        ;; EQL, I suggest either just using DEFVAR (which is usually
        ;; appropriate, despite the un-mnemonic name), or defining
-       ;; something like SB-INT:DEFCONSTANT-EQX (which is occasionally
-       ;; more appropriate). -- WHN 2000-11-03
+       ;; something like the DEFCONSTANT-EQX macro used in SBCL (which
+       ;; is occasionally more appropriate). -- WHN 2001-12-21
        (unless (eql value
 		    (info :variable :constant-value name))
 	 (cerror "Go ahead and change the value."
@@ -180,6 +180,32 @@ the usual naming convention (names like *FOO*) for special variables"
 	(info :variable :constant-value name) value)
   name)
 
+;;;; DEFINE-SYMBOL-MACRO
+
+(defmacro-mundanely define-symbol-macro (name expansion)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+    (sb!c::%define-symbol-macro ',name ',expansion)))
+
+(defun sb!c::%define-symbol-macro (name expansion)
+  (unless (symbolp name)
+    (error 'simple-type-error :datum name :expected-type 'symbol
+	   :format-control "Symbol macro name is not a symbol: ~S."
+	   :format-arguments (list name)))
+  (ecase (info :variable :kind name)
+    ((:macro :global nil)
+     (setf (info :variable :kind name) :macro)
+     (setf (info :variable :macro-expansion name) expansion))
+    (:special
+     (error 'simple-program-error
+	    :format-control "Symbol macro name already declared special: ~S."
+	    :format-arguments (list name)))
+    (:constant
+     (error 'simple-program-error
+	    :format-control "Symbol macro name already declared constant: ~S."
+	    :format-arguments (list name))))
+  name)
+
+
 ;;;; DEFINE-COMPILER-MACRO
 
 ;;; FIXME: The logic here for handling compiler macros named (SETF
@@ -448,7 +474,7 @@ the usual naming convention (names like *FOO*) for special variables"
   code in BODY to provide possible further output."
   `(%print-unreadable-object ,object ,stream ,type ,identity
 			     ,(if body
-				  `#'(lambda () ,@body)
+				  `(lambda () ,@body)
 				  nil)))
 
 (defmacro-mundanely ignore-errors (&rest forms)