X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flate-macros.lisp;h=39b53c683909954f47100bb464e0990e5111ae68;hb=25070981025894faaef260a38b83fd0bbcfdc80d;hp=8a135204f8e57357d8be6c14e3595a3a03502c55;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/late-macros.lisp b/src/compiler/late-macros.lisp
index 8a13520..39b53c6 100644
--- 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,26 +17,23 @@
 
 (in-package "SB!C")
 
-(file-comment
-  "$Header$")
-
+;;; 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))
@@ -45,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
@@ -79,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
@@ -132,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)