(second form))
(t form)))
-(declaim (ftype (function (symbol &optional (or null sb!c::lexenv))) sb!xc:macro-function))
(defun sb!xc:macro-function (symbol &optional env)
#!+sb-doc
"If SYMBOL names a macro in ENV, returns the expansion function,
(let* ((fenv (when env (sb!c::lexenv-funs env)))
(local-def (cdr (assoc symbol fenv))))
(cond (local-def
- (if (and (consp local-def) (eq (car local-def) 'MACRO))
+ (if (and (consp local-def) (eq (car local-def) 'macro))
(cdr local-def)
nil))
((eq (info :function :kind symbol) :macro)
(t
nil))))
-;;; Note: Technically there could be an ENV optional argument to SETF
-;;; MACRO-FUNCTION, but since ANSI says that the consequences of
-;;; supplying that optional argument are undefined, we don't allow it.
-;;; (Thus our implementation of this unspecified behavior is to
-;;; complain that the wrong number of arguments was supplied. Since
-;;; the behavior is unspecified, this is conforming.:-)
-(defun (setf sb!xc:macro-function) (function symbol)
+(defun (setf sb!xc:macro-function) (function symbol &optional environment)
(declare (symbol symbol) (type function function))
+ (when environment
+ ;; Note: Technically there could be an ENV optional argument to SETF
+ ;; MACRO-FUNCTION, but since ANSI says that the consequences of
+ ;; supplying a non-nil one are undefined, we don't allow it.
+ ;; (Thus our implementation of this unspecified behavior is to
+ ;; complain. SInce the behavior is unspecified, this is conforming.:-)
+ (error "Non-NIL environment argument in SETF of MACRO-FUNCTION ~S: ~S"
+ symbol environment))
(when (eq (info :function :kind symbol) :special-form)
(error "~S names a special form." symbol))
(setf (info :function :kind symbol) :macro)
(error "can't SETF COMPILER-MACRO-FUNCTION when ENV is non-NIL"))
(when (eq (info :function :kind name) :special-form)
(error "~S names a special form." name))
- (setf (info :function :compiler-macro-function name) function)
- function)
+ (with-single-package-locked-error
+ (:symbol name "setting the compiler-macro-function of ~A")
+ (setf (info :function :compiler-macro-function name) function)
+ function))
\f
;;;; a subset of DOCUMENTATION functionality for bootstrapping
(typecase x
(structure-class (values (info :type :documentation (class-name x))))
(t (and (typep x 'symbol) (values (info :type :documentation x))))))
- (setf (info :setf :documentation x))
+ (setf (values (info :setf :documentation x)))
((t)
(typecase x
(function (%fun-doc x))