- ;; OAOO violation: this duplicates code in SB-INTROSPECT.
- ;; Additionally, there are some functions that aren't
- ;; funcallable-instances for which finding the source location is
- ;; complicated (e.g. DEFSTRUCT-defined predicates and accessors),
- ;; but I don't think they're defined with %DEFUN, so the warning
- ;; isn't raised.
- (flet ((fdefinition-file-namestring (fdefn)
- #!+sb-eval
- (when (typep fdefn 'sb!eval:interpreted-function)
- (return-from fdefinition-file-namestring
- (sb!c:definition-source-location-namestring
- (sb!eval:interpreted-function-source-location fdefn))))
- ;; All the following accesses are guarded with conditionals
- ;; because it's not clear whether any of the slots we're
- ;; chasing down are guaranteed to be filled in.
- (let* ((fdefn
- ;; KLUDGE: although this looks like it only works
- ;; for %SIMPLE-FUNs, in fact there's a pun such
- ;; that %SIMPLE-FUN-SELF returns the simple-fun
- ;; object for closures and
- ;; funcallable-instances. -- CSR, circa 2005
- (sb!kernel:%simple-fun-self fdefn))
- (code (if fdefn (sb!kernel:fun-code-header fdefn)))
- (debug-info (if code (sb!kernel:%code-debug-info code)))
- (debug-source (if debug-info
- (sb!c::debug-info-source debug-info)))
- (namestring (if debug-source
- (sb!c::debug-source-namestring debug-source))))
- namestring)))
- (and
- ;; There's garbage in various places when the first DEFUN runs in
- ;; cold-init.
- sb!kernel::*cold-init-complete-p*
- (typep warning 'redefinition-with-defun)
- (let ((old-fdefn
- (function-redefinition-warning-old-fdefinition warning))
- (new-fdefn
- (redefinition-with-defun-new-fdefinition warning)))
- ;; Replacing a compiled function with a compiled function is
- ;; clearly uninteresting, and we'll say arbitrarily that
- ;; replacing an interpreted function with an interpreted
- ;; function is uninteresting, too, but leave out the
- ;; compiled-to-interpreted and interpreted-to-compiled cases.
- (when (or (and (typep old-fdefn
- '(or #!+sb-eval sb!eval:interpreted-function))
- (typep new-fdefn
- '(or #!+sb-eval sb!eval:interpreted-function)))
- (and (typep old-fdefn
- '(and compiled-function
- (not funcallable-instance)))
- ;; Since this is a REDEFINITION-WITH-DEFUN,
- ;; NEW-FDEFN can't be a FUNCALLABLE-INSTANCE.
- (typep new-fdefn 'compiled-function)))
- (let* ((old-namestring (fdefinition-file-namestring old-fdefn))
- (new-namestring
- (or (fdefinition-file-namestring new-fdefn)
- (let ((srcloc
- (redefinition-with-defun-new-location warning)))
- (if srcloc
- (sb!c::definition-source-location-namestring
- srcloc))))))
- (and old-namestring
- new-namestring
- (equal old-namestring new-namestring))))))))
+ (and
+ ;; There's garbage in various places when the first DEFUN runs in
+ ;; cold-init.
+ sb!kernel::*cold-init-complete-p*
+ (typep warning 'redefinition-with-defun)
+ ;; Shared logic.
+ (let ((name (redefinition-warning-name warning)))
+ (not (interesting-function-redefinition-warning-p
+ warning (or (fdefinition name) (macro-function name)))))))
+
+(defun uninteresting-macro-redefinition-p (warning)
+ (and
+ (typep warning 'redefinition-with-defmacro)
+ ;; Shared logic.
+ (let ((name (redefinition-warning-name warning)))
+ (not (interesting-function-redefinition-warning-p
+ warning (or (macro-function name) (fdefinition name)))))))