0.9.15.46: cosmetic cleanups
authorNikodemus Siivola <nikodemus@random-state.net>
Tue, 22 Aug 2006 15:48:56 +0000 (15:48 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Tue, 22 Aug 2006 15:48:56 +0000 (15:48 +0000)
 * SLOT-VALUE-OR-DEFAULT now uses an UNREADABLE-OBJECT as the default
   marker for unbound slots, giving us #<unbound slot> instead of "unbound".
 * Edit special operator docstrings for consistency.
 * Whitespace.

package-data-list.lisp-expr
src/assembly/assemfile.lisp
src/code/debug.lisp
src/code/late-extensions.lisp
src/compiler/ir1-translators.lisp
src/pcl/boot.lisp
src/pcl/methods.lisp
src/pcl/slots.lisp
tests/mop.impure.lisp
version.lisp-expr

index f60e23f..2fa1bf0 100644 (file)
@@ -890,6 +890,7 @@ retained, possibly temporariliy, because it might be used internally."
                "DEPRECATION-WARNING"
                "BIT-VECTOR-="
                "READ-EVALUATED-FORM"
+               "MAKE-UNPRINTABLE-OBJECT"
 
                ;; ..and macros..
                "COLLECT"
index 591acfb..837b239 100644 (file)
   (multiple-value-bind (name options)
       (if (atom name&options)
           (values name&options nil)
-        (values (car name&options)
-                (cdr name&options)))
+          (values (car name&options)
+                  (cdr name&options)))
     (let ((regs (mapcar (lambda (var) (apply #'parse-reg-spec var)) vars)))
       (if *emit-assembly-code-not-vops-p*
           (emit-assemble name options regs code)
index 510501e..cad19af 100644 (file)
@@ -223,17 +223,6 @@ is how many frames to show."
 
 ) ; EVAL-WHEN
 
-;;; This is used in constructing arg lists for debugger printing when
-;;; the arg list is unavailable, some arg is unavailable or unused, etc.
-(defstruct (unprintable-object
-            (:constructor make-unprintable-object (string))
-            (:print-object (lambda (x s)
-                             (print-unreadable-object (x s)
-                               (write-string (unprintable-object-string x)
-                                             s))))
-            (:copier nil))
-  string)
-
 ;;; Extract the function argument values for a debug frame.
 (defun frame-args-as-list (frame)
   (let ((debug-fun (sb!di:frame-debug-fun frame))
index a841f90..4d0e08b 100644 (file)
 ;;;      ;;     be doing him a favor by printing the object here.
 ;;;      ;; -- WHN 2002-10-19
 ;;;      (error "can't calculate length of cyclic list")))
+
+;;; This is used in constructing arg lists for debugger printing,
+;;; and when needing to print unbound slots in PCL.
+(defstruct (unprintable-object
+            (:constructor make-unprintable-object (string))
+            (:print-object (lambda (x s)
+                             (print-unreadable-object (x s)
+                               (write-string (unprintable-object-string x) s))))
+            (:copier nil))
+  string)
index c8b2473..0ca97d2 100644 (file)
 
 (def-ir1-translator progn ((&rest forms) start next result)
   #!+sb-doc
-  "Progn Form*
-  Evaluates each Form in order, returning the values of the last form. With no
-  forms, returns NIL."
+  "PROGN form*
+
+Evaluates each FORM in order, returning the values of the last form. With no
+forms, returns NIL."
   (ir1-convert-progn-body start next result forms))
 
 (def-ir1-translator if ((test then &optional else) start next result)
   #!+sb-doc
-  "If Predicate Then [Else]
-  If Predicate evaluates to non-null, evaluate Then and returns its values,
-  otherwise evaluate Else and return its values. Else defaults to NIL."
+  "IF predicate then [else]
+
+If PREDICATE evaluates to false, evaluate THEN and return its values,
+otherwise evaluate ELSE and return its values. ELSE defaults to NIL."
   (let* ((pred-ctran (make-ctran))
          (pred-lvar (make-lvar))
          (then-ctran (make-ctran))
 ;;; environment.
 (def-ir1-translator block ((name &rest forms) start next result)
   #!+sb-doc
-  "Block Name Form*
-  Evaluate the Forms as a PROGN. Within the lexical scope of the body,
-  (RETURN-FROM Name Value-Form) can be used to exit the form, returning the
-  result of Value-Form."
+  "BLOCK name form*
+
+Evaluate the FORMS as a PROGN. Within the lexical scope of the body,
+RETURN-FROM can be used to exit the form."
   (unless (symbolp name)
     (compiler-error "The block name ~S is not a symbol." name))
   (start-block start)
 
 (def-ir1-translator return-from ((name &optional value) start next result)
   #!+sb-doc
-  "Return-From Block-Name Value-Form
-  Evaluate the Value-Form, returning its values from the lexically enclosing
-  BLOCK Block-Name. This is constrained to be used only within the dynamic
-  extent of the BLOCK."
+  "RETURN-FROM block-name value-form
+
+Evaluate the VALUE-FORM, returning its values from the lexically enclosing
+block BLOCK-NAME. This is constrained to be used only within the dynamic
+extent of the block."
   ;; old comment:
   ;;   We make NEXT start a block just so that it will have a block
   ;;   assigned. People assume that when they pass a ctran into
 ;;; values.
 (def-ir1-translator tagbody ((&rest statements) start next result)
   #!+sb-doc
-  "Tagbody {Tag | Statement}*
-  Define tags for used with GO. The Statements are evaluated in order
-  (skipping Tags) and NIL is returned. If a statement contains a GO to a
-  defined Tag within the lexical scope of the form, then control is transferred
-  to the next statement following that tag. A Tag must an integer or a
-  symbol. A statement must be a list. Other objects are illegal within the
-  body."
+  "TAGBODY {tag | statement}*
+
+Define tags for use with GO. The STATEMENTS are evaluated in order ,skipping
+TAGS, and NIL is returned. If a statement contains a GO to a defined TAG
+within the lexical scope of the form, then control is transferred to the next
+statement following that tag. A TAG must an integer or a symbol. A STATEMENT
+must be a list. Other objects are illegal within the body."
   (start-block start)
   (ctran-starts-block next)
   (let* ((dummy (make-ctran))
 ;;; Emit an EXIT node without any value.
 (def-ir1-translator go ((tag) start next result)
   #!+sb-doc
-  "Go Tag
-  Transfer control to the named Tag in the lexically enclosing TAGBODY. This
-  is constrained to be used only within the dynamic extent of the TAGBODY."
+  "GO tag
+
+Transfer control to the named TAG in the lexically enclosing TAGBODY. This is
+constrained to be used only within the dynamic extent of the TAGBODY."
   (ctran-starts-block next)
   (let* ((found (or (lexenv-find tag tags :test #'eql)
                     (compiler-error "attempt to GO to nonexistent tag: ~S"
 ;;;   form; otherwise, the forms in the body are ignored.
 (def-ir1-translator eval-when ((situations &rest forms) start next result)
   #!+sb-doc
-  "EVAL-WHEN (Situation*) Form*
-  Evaluate the Forms in the specified Situations (any of :COMPILE-TOPLEVEL,
-  :LOAD-TOPLEVEL, or :EXECUTE, or (deprecated) COMPILE, LOAD, or EVAL)."
+  "EVAL-WHEN (situation*) form*
+
+Evaluate the FORMS in the specified SITUATIONS (any of :COMPILE-TOPLEVEL,
+:LOAD-TOPLEVEL, or :EXECUTE, or (deprecated) COMPILE, LOAD, or EVAL)."
   (multiple-value-bind (ct lt e) (parse-eval-when-situations situations)
     (declare (ignore ct lt))
     (ir1-convert-progn-body start next result (and e forms)))
 
 (def-ir1-translator macrolet ((definitions &rest body) start next result)
   #!+sb-doc
-  "MACROLET ({(Name Lambda-List Form*)}*) Body-Form*
-  Evaluate the Body-Forms in an environment with the specified local macros
-  defined. Name is the local macro name, Lambda-List is the DEFMACRO style
-  destructuring lambda list, and the Forms evaluate to the expansion.."
+  "MACROLET ({(name lambda-list form*)}*) body-form*
+
+Evaluate the BODY-FORMS in an environment with the specified local macros
+defined. Name is the local macro name, LAMBDA-LIST is a DEFMACRO style
+destructuring lambda list, and the FORMS evaluate to the expansion."
   (funcall-in-macrolet-lexenv
    definitions
    (lambda (&key funs)
 (def-ir1-translator symbol-macrolet
     ((macrobindings &body body) start next result)
   #!+sb-doc
-  "SYMBOL-MACROLET ({(Name Expansion)}*) Decl* Form*
-  Define the Names as symbol macros with the given Expansions. Within the
-  body, references to a Name will effectively be replaced with the Expansion."
+  "SYMBOL-MACROLET ({(name expansion)}*) decl* form*
+
+Define the NAMES as symbol macros with the given EXPANSIONS. Within the
+body, references to a NAME will effectively be replaced with the EXPANSION."
   (funcall-in-symbol-macrolet-lexenv
    macrobindings
    (lambda (&key vars)
 
 (def-ir1-translator quote ((thing) start next result)
   #!+sb-doc
-  "QUOTE Value
-  Return Value without evaluating it."
+  "QUOTE value
+
+Return VALUE without evaluating it."
   (reference-constant start next result thing))
 \f
 ;;;; FUNCTION and NAMED-LAMBDA
 
 (def-ir1-translator function ((thing) start next result)
   #!+sb-doc
-  "FUNCTION Name
-  Return the lexically apparent definition of the function Name. Name may also
-  be a lambda expression."
+  "FUNCTION name
+
+Return the lexically apparent definition of the function NAME. NAME may also
+be a lambda expression."
   (with-fun-name-leaf (leaf thing start)
     (reference-leaf start next result leaf)))
 
 
 (def-ir1-translator let ((bindings &body body) start next result)
   #!+sb-doc
-  "LET ({(Var [Value]) | Var}*) Declaration* Form*
-  During evaluation of the Forms, bind the Vars to the result of evaluating the
-  Value forms. The variables are bound in parallel after all of the Values are
-  evaluated."
+  "LET ({(var [value]) | var}*) declaration* form*
+
+During evaluation of the FORMS, bind the VARS to the result of evaluating the
+VALUE forms. The variables are bound in parallel after all of the VALUES forms
+have been evaluated."
   (cond ((null bindings)
          (ir1-translate-locally body start next result))
         ((listp bindings)
 (def-ir1-translator let* ((bindings &body body)
                           start next result)
   #!+sb-doc
-  "LET* ({(Var [Value]) | Var}*) Declaration* Form*
-  Similar to LET, but the variables are bound sequentially, allowing each Value
-  form to reference any of the previous Vars."
+  "LET* ({(var [value]) | var}*) declaration* form*
+
+Similar to LET, but the variables are bound sequentially, allowing each VALUE
+form to reference any of the previous VARS."
   (if (listp bindings)
       (multiple-value-bind (forms decls)
           (parse-body body :doc-string-allowed nil)
 
 (def-ir1-translator locally ((&body body) start next result)
   #!+sb-doc
-  "LOCALLY Declaration* Form*
-  Sequentially evaluate the Forms in a lexical environment where the
-  the Declarations have effect. If LOCALLY is a top level form, then
-  the Forms are also processed as top level forms."
+  "LOCALLY declaration* form*
+
+Sequentially evaluate the FORMS in a lexical environment where the the
+DECLARATIONS have effect. If LOCALLY is a top level form, then the FORMS are
+also processed as top level forms."
   (ir1-translate-locally body start next result))
 \f
 ;;;; FLET and LABELS
 (def-ir1-translator flet ((definitions &body body)
                           start next result)
   #!+sb-doc
-  "FLET ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
-  Evaluate the Body-Forms with some local function definitions. The bindings
-  do not enclose the definitions; any use of Name in the Forms will refer to
-  the lexically apparent function definition in the enclosing environment."
+  "FLET ({(name lambda-list declaration* form*)}*) declaration* body-form*
+
+Evaluate the BODY-FORMS with local function definitions. The bindings do
+not enclose the definitions; any use of NAME in the FORMS will refer to the
+lexically apparent function definition in the enclosing environment."
   (multiple-value-bind (forms decls)
       (parse-body body :doc-string-allowed nil)
     (multiple-value-bind (names defs)
 
 (def-ir1-translator labels ((definitions &body body) start next result)
   #!+sb-doc
-  "LABELS ({(Name Lambda-List Declaration* Form*)}*) Declaration* Body-Form*
-  Evaluate the Body-Forms with some local function definitions. The bindings
-  enclose the new definitions, so the defined functions can call themselves or
-  each other."
+  "LABELS ({(name lambda-list declaration* form*)}*) declaration* body-form*
+
+Evaluate the BODY-FORMS with local function definitions. The bindings enclose
+the new definitions, so the defined functions can call themselves or each
+other."
   (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
     (multiple-value-bind (names defs)
         (extract-flet-vars definitions 'labels)
 ;;; properties other than receiving multiple-values.
 (def-ir1-translator throw ((tag result) start next result-lvar)
   #!+sb-doc
-  "Throw Tag Form
-  Do a non-local exit, return the values of Form from the CATCH whose tag
-  evaluates to the same thing as Tag."
+  "THROW tag form
+
+Do a non-local exit, return the values of FORM from the CATCH whose tag is EQ
+to TAG."
   (ir1-convert start next result-lvar
                `(multiple-value-call #'%throw ,tag ,result)))
 
 
 (def-ir1-translator catch ((tag &body body) start next result)
   #!+sb-doc
-  "Catch Tag Form*
-  Evaluate TAG and instantiate it as a catcher while the body forms are
-  evaluated in an implicit PROGN. If a THROW is done to TAG within the dynamic
-  scope of the body, then control will be transferred to the end of the body
-  and the thrown values will be returned."
+  "CATCH tag form*
+
+Evaluate TAG and instantiate it as a catcher while the body forms are
+evaluated in an implicit PROGN. If a THROW is done to TAG within the dynamic
+scope of the body, then control will be transferred to the end of the body and
+the thrown values will be returned."
   ;; We represent the possibility of the control transfer by making an
   ;; "escape function" that does a lexical exit, and instantiate the
   ;; cleanup using %WITHIN-CLEANUP.
 (def-ir1-translator unwind-protect
     ((protected &body cleanup) start next result)
   #!+sb-doc
-  "Unwind-Protect Protected Cleanup*
-  Evaluate the form PROTECTED, returning its values. The CLEANUP forms are
-  evaluated whenever the dynamic scope of the PROTECTED form is exited (either
-  due to normal completion or a non-local exit such as THROW)."
+  "UNWIND-PROTECT protected cleanup*
+
+Evaluate the form PROTECTED, returning its values. The CLEANUP forms are
+evaluated whenever the dynamic scope of the PROTECTED form is exited (either
+due to normal completion or a non-local exit such as THROW)."
   ;; UNWIND-PROTECT is similar to CATCH, but hairier. We make the
   ;; cleanup forms into a local function so that they can be referenced
   ;; both in the case where we are unwound and in any local exits. We
 
 (def-ir1-translator multiple-value-call ((fun &rest args) start next result)
   #!+sb-doc
-  "MULTIPLE-VALUE-CALL Function Values-Form*
-  Call FUNCTION, passing all the values of each VALUES-FORM as arguments,
-  values from the first VALUES-FORM making up the first argument, etc."
+  "MULTIPLE-VALUE-CALL function values-form*
+
+Call FUNCTION, passing all the values of each VALUES-FORM as arguments,
+values from the first VALUES-FORM making up the first argument, etc."
   (let* ((ctran (make-ctran))
          (fun-lvar (make-lvar))
          (node (if args
 (def-ir1-translator multiple-value-prog1
     ((values-form &rest forms) start next result)
   #!+sb-doc
-  "MULTIPLE-VALUE-PROG1 Values-Form Form*
-  Evaluate Values-Form and then the Forms, but return all the values of
-  Values-Form."
+  "MULTIPLE-VALUE-PROG1 values-form form*
+
+Evaluate VALUES-FORM and then the FORMS, but return all the values of
+VALUES-FORM."
   (let ((dummy (make-ctran)))
     (ctran-starts-block dummy)
     (ir1-convert start dummy result values-form)
index 6d60aee..46aa611 100644 (file)
@@ -2202,9 +2202,9 @@ bootstrapping.
                                arglist
                                &rest initargs)
   (let* (;; we don't need to deal with the :generic-function-class
-        ;; argument here because the default,
-        ;; STANDARD-GENERIC-FUNCTION, is right for all early generic
-        ;; functions.  (See REAL-ADD-NAMED-METHOD)
+         ;; argument here because the default,
+         ;; STANDARD-GENERIC-FUNCTION, is right for all early generic
+         ;; functions.  (See REAL-ADD-NAMED-METHOD)
          (gf (ensure-generic-function generic-function-name))
          (existing
            (dolist (m (early-gf-methods gf))
index c395c7b..b192b02 100644 (file)
   (let* ((existing-gf (find-generic-function generic-function-name nil))
          (generic-function
           (if existing-gf
-              (ensure-generic-function 
+              (ensure-generic-function
                generic-function-name
                :generic-function-class (class-of existing-gf))
               (ensure-generic-function generic-function-name)))
index a37f983..1b1326b 100644 (file)
   (let ((class (class-of object)))
     (not (null (find-slot-definition class slot-name)))))
 
+(defvar *unbound-slot-value-marker* (make-unprintable-object "unbound slot"))
+
 ;;; This isn't documented, but is used within PCL in a number of print
 ;;; object methods. (See NAMED-OBJECT-PRINT-FUNCTION.)
-(defun slot-value-or-default (object slot-name &optional (default "unbound"))
+(defun slot-value-or-default (object slot-name &optional
+                              (default *unbound-slot-value-marker*))
   (if (slot-boundp object slot-name)
       (slot-value object slot-name)
       default))
index 765d222..f4c181d 100644 (file)
 \f
 ;;; ensure-class got its treatment of :metaclass wrong.
 (ensure-class 'better-be-standard-class :direct-superclasses '(standard-object)
-              :metaclass 'standard-class 
+              :metaclass 'standard-class
               :metaclass 'funcallable-standard-class)
 (assert (eq (class-of (find-class 'better-be-standard-class))
             (find-class 'standard-class)))
index 6a171ab..6b2a62c 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.15.45"
+"0.9.15.46"