(in-package "SB!C")
-(file-comment
- "$Header$")
-
#+sb-xc-host
(sb!xc:defmacro def-boolean-attribute (name &rest attribute-names)
#!+sb-doc
NAME-attributes attribute-name*
Return a set of the named attributes."
- (let ((const-name (symbolicate name "-ATTRIBUTE-TRANSLATIONS"))
+ (let ((translations-name (symbolicate "*" name "-ATTRIBUTE-TRANSLATIONS*"))
(test-name (symbolicate name "-ATTRIBUTEP")))
(collect ((alist))
(do ((mask 1 (ash mask 1))
(alist (cons (car names) mask)))
`(progn
+
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defconstant ,const-name ',(alist)))
+ (defparameter ,translations-name ',(alist)))
(defmacro ,test-name (attributes &rest attribute-names)
"Automagically generated boolean attribute test function. See
Def-Boolean-Attribute."
- `(logtest ,(compute-attribute-mask attribute-names ,const-name)
+ `(logtest ,(compute-attribute-mask attribute-names
+ ,translations-name)
(the attributes ,attributes)))
(define-setf-expander ,test-name (place &rest attributes
env
(compute-attribute-mask
attributes
- ,const-name
+ ,translations-name
)
',test-name))
(defmacro ,(symbolicate name "-ATTRIBUTES") (&rest attribute-names)
"Automagically generated boolean attribute creation function. See
Def-Boolean-Attribute."
- (compute-attribute-mask attribute-names ,const-name))))))
+ (compute-attribute-mask attribute-names ,translations-name))))))
;;; a helper function for the cross-compilation target Lisp code which
;;; DEF-BOOLEAN-ATTRIBUTE expands into
;;; to use code like this, to factor out some shared functionality for clarity
;;; and for economy. But the motivation for splitting out this code here is
;;; much weirder. In the current version of the code, the cross-compiler calls
-;;; UNCROSS on each top-level form before processing it. Ordinarily, UNCROSS
+;;; UNCROSS on each top level form before processing it. Ordinarily, UNCROSS
;;; isn't called on macro expansions, but since DEF-BOOLEAN-ATTRIBUTE expands
;;; into a PROGN, the cross-compiler does end up calling UNCROSS on (the
-;;; components of) its macroexpansion, since they're separate top-level forms.
+;;; components of) its macroexpansion, since they're separate top level forms.
;;; In the classic CMU CL macroexpansion, the call to GET-SETF-EXPANSION is in
;;; the macroexpansion, and even when I translate it to
;;; SB!XC:GET-SETF-MACROEXPANSION so that it will work on target code, my