Unless I'm mistaken, WHN in some of his seminal work added a redundant mechanism for detecting SETF macros that are defined after the existence of #'(SETF X) has been assumed.
Namely, the *SETF-ASSUMED-FBOUNDP* table contains an entry whenever IR2 emits a call to (SETF X). This differs in a subtle and not useful - I would go so far as to say "wrong" - way from the same information in globaldb that tells us that (SETF X) has been assumed to exist.
The extraneous mechanism relies on PONDER-FULL-CALL. Supposing IR1 makes a ref to #'(SETF FOO) but IR2 deals with it such that no full call occurs, how can it possibly be right not to warn about a subsequent defsetf for FOO? Surely it's fishy that _any_ other thing whatsoever co-exists with a user-defined expander of the macro-like variety.
Following is the bulk of the patch to change the check to use (info :function :where-from).
The other 2 places to edit are in 'globaldb' and 'ir2tran' but those are trivial deletions.
Also I believe the FIXME (which I deleted) pertained to a misunderstanding about why both :INVERSE and :EXPANDER are examined. It has nothing to do with host/target issues.
@@ -342,24 +342,25 @@
#+sb-xc-host (declare (ignore expander-lambda-list))
(:symbol name "defining a setf-expander for ~A"))
- (cond ((gethash name sb!c:*setf-assumed-fboundp*)
- "defining setf macro for ~S when ~S was previously ~
+ (let ((setf-fn-name `(setf ,name)))
+ (cond ((eq (sb-c::info :function :where-from setf-fn-name) :assumed)
+ "defining setf macro for ~S when ~S was previously ~
treated as a function"
- `(setf ,name)))
- ((not (fboundp `(setf ,name)))
- ;; All is well, we don't need any warnings.
- ((not (eq (symbol-package name) (symbol-package 'aref)))
- (style-warn "defining setf macro for ~S when ~S is fbound"
- name `(setf ,name))))
- (remhash name sb!c:*setf-assumed-fboundp*)
+ name setf-fn-name))
+ ((not (fboundp setf-fn-name))
+ ;; All is well, we don't need any warnings.
+ ;; Apparently this test is trying to say that we suppress
+ ;; warnings where host CL provides functional (SETF thing)
+ ;; during XC but we want the same as an expander.
+ ;; Is this the clearest way?
+ ((not (eq (symbol-package name) (symbol-package 'aref)))
+ (style-warn "defining setf macro for ~S when ~S is fbound"
+ name setf-fn-name))))
(setf (%fun-lambda-list expander) expander-lambda-list))
- ;; FIXME: It's probably possible to join these checks into one form which
- ;; is appropriate both on the cross-compilation host and on the target.
(when (or inverse (info :setf :inverse name))
(setf (info :setf :inverse name) inverse))
(when (or expander (info :setf :expander name))