0.7.8.41:

[sbcl.git] / src / compiler / late-macros.lisp

diff --git a/src/compiler/late-macros.lisp b/src/compiler/late-macros.lisp
index 9d617f2..39b53c6 100644 (file)
--- a/src/compiler/late-macros.lisp
+++ b/src/compiler/late-macros.lisp
@@ -4,7 +4,7 @@
 ;;;; this code can't appear in the build sequence until after
 ;;;; SB!XC:DEFMACRO has been defined, and so this stuff is separated
 ;;;; out of the main compiler/macros.lisp file (which has to appear
-;;;; earlier)
+;;;; earlier).
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -17,23 +17,23 @@
 
 (in-package "SB!C")
 
+;;; Def-Boolean-Attribute Name Attribute-Name*
+;;;
+;;; Define a new class of Boolean attributes, with the attributes
+;;; having the specified ATTRIBUTE-NAMES. NAME is the name of the
+;;; class, which is used to generate some macros to manipulate sets of
+;;; the attributes:
+;;;
+;;;   NAME-attributep attributes attribute-name*
+;;;     Return true if any of the named attributes are present, false
+;;;     otherwise. When set with SETF, updates the place Attributes
+;;;     setting or clearing the specified attributes.
+;;;
+;;;   NAME-attributes attribute-name*
+;;;     Return a set of the named attributes.
 #+sb-xc-host
 (sb!xc:defmacro def-boolean-attribute (name &rest attribute-names)
-  #!+sb-doc
-  "Def-Boolean-Attribute Name Attribute-Name*
-  Define a new class of boolean attributes, with the attributes having the
-  specified Attribute-Names. Name is the name of the class, which is used to
-  generate some macros to manipulate sets of the attributes:
-
-    NAME-attributep attributes attribute-name*
-      Return true if one of the named attributes is present, false otherwise.
-      When set with SETF, updates the place Attributes setting or clearing the
-      specified attributes.
-
-    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))
@@ -42,32 +42,34 @@
        (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)
+          "Automagically generated Boolean attribute test function. See
+           DEF-BOOLEAN-ATTRIBUTE."
+          `(logtest ,(compute-attribute-mask attribute-names
+                                             ,translations-name)
                     (the attributes ,attributes)))
 
         (define-setf-expander ,test-name (place &rest attributes
                                                 &environment env)
-          "Automagically generated boolean attribute setter. See
-           Def-Boolean-Attribute."
+          "Automagically generated Boolean attribute setter. See
+           DEF-BOOLEAN-ATTRIBUTE."
           (boolean-attribute-setter--target place
                                             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))))))
+          "Automagically generated Boolean attribute creation function. See
+           DEF-BOOLEAN-ATTRIBUTE."
+          (compute-attribute-mask attribute-names ,translations-name))))))
 
 ;;; a helper function for the cross-compilation target Lisp code which
 ;;; DEF-BOOLEAN-ATTRIBUTE expands into
@@ -76,10 +78,10 @@
 ;;; 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
@@ -129,11 +131,10 @@
                        (,next ,n-current)))))
         (values)))))
 
+;;; Push ITEM onto a list linked by the accessor function NEXT that is
+;;; stored in PLACE.
 #+sb-xc-host
 (sb!xc:defmacro push-in (next item place &environment env)
-  #!+sb-doc
-  "Push Item onto a list linked by the accessor function Next that is stored in
-  Place."
   (multiple-value-bind (temps vals stores store access)
       (sb!xc:get-setf-expansion place env)
     (when (cdr stores)