0.pre7.86.flaky7.10:
authorWilliam Harold Newman <william.newman@airmail.net>
Sat, 24 Nov 2001 22:54:58 +0000 (22:54 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Sat, 24 Nov 2001 22:54:58 +0000 (22:54 +0000)
(now gets to src/pcl/print-object.lisp in warm init before
dying)
s/function/fun/ in DEFSTRUCT PPRINT-DISPATCH-ENTRY to match
the s/function/fun/ in slot accessor names elsewhere

src/code/debug.lisp
src/code/defboot.lisp
src/code/pprint.lisp
src/code/print.lisp

index d39885a..0bf080f 100644 (file)
@@ -632,6 +632,10 @@ reset to ~S."
            (*print-pretty* t)
            (*package* original-package))
 
+       ;; REMOVEME (In the flaky7 branch, I've been having 
+       ;; problems with the pretty printer...)
+       (setf *print-pretty* nil)
+
        ;; Before we start our own output, finish any pending output.
        ;; Otherwise, if the user tried to track the progress of
        ;; his program using PRINT statements, he'd tend to lose
index 08736d3..b8a9ddd 100644 (file)
 (defun %defun (name def doc)
   (declare (type function def))
   (declare (type (or null simple-string doc)))
-  (/show0 "entering %DEFUN, name (or block name) = ..")
-  (/primitive-print (symbol-name (fun-name-block-name name)))
   (aver (legal-fun-name-p name))
   (when (fboundp name)
-    (/show0 "redefining NAME")
+    (/show0 "redefining NAME in %DEFUN")
     (style-warn "redefining ~S in DEFUN" name))
-  (/show0 "setting FDEFINITION")
   (setf (sb!xc:fdefinition name) def)
   (when doc
     ;; FIXME: This should use shared SETF-name-parsing logic.
-    (/show0 "setting FDOCUMENTATION")
     (if (and (consp name) (eq (first name) 'setf))
        (setf (fdocumentation (second name) 'setf) doc)
        (setf (fdocumentation (the symbol name) 'function) doc)))
-  (/show0 "leaving %DEFUN")
   name)
 \f
 ;;;; DEFVAR and DEFPARAMETER
index a6ccaa7..390149c 100644 (file)
   ;; T iff one of the original entries.
   (initial-p *building-initial-table* :type (member t nil))
   ;; and the associated function
-  (function (missing-arg) :type function))
+  (fun (missing-arg) :type function))
 (def!method print-object ((entry pprint-dispatch-entry) stream)
   (print-unreadable-object (entry stream :type t)
     (format stream "type=~S, priority=~S~@[ [initial]~]"
       (if (cons-type-specifier-p type)
          (setf (gethash (second (second type))
                         (pprint-dispatch-table-cons-entries table))
-               (make-pprint-dispatch-entry :type type :priority priority
-                                           :function function))
+               (make-pprint-dispatch-entry :type type
+                                           :priority priority
+                                           :fun function))
          (let ((list (delete type (pprint-dispatch-table-entries table)
                              :key #'pprint-dispatch-entry-type
                              :test #'equal))
                (entry (make-pprint-dispatch-entry
-                       :type type :test-fn (compute-test-fn type)
-                       :priority priority :function function)))
+                       :type type
+                       :test-fn (compute-test-fn type)
+                       :priority priority
+                       :fun function)))
            (do ((prev nil next)
                 (next list (cdr next)))
                ((null next)
 \f
 ;;;; the interface seen by regular (ugly) printer and initialization routines
 
-;;; OUTPUT-PRETTY-OBJECT is called by OUTPUT-OBJECT when *PRINT-PRETTY* is
-;;; bound to T.
+;;; OUTPUT-PRETTY-OBJECT is called by OUTPUT-OBJECT when
+;;; *PRINT-PRETTY* is true.
 (defun output-pretty-object (object stream)
-  (/show0 "entering OUTPUT-PRETTY-OBJECT")
   (with-pretty-stream (stream)
     (funcall (pprint-dispatch object) stream object)))
 
index 5e8d6c3..92d66f9 100644 (file)
 (defun output-object (object stream)
   (/show0 "entering OUTPUT-OBJECT")
   (labels ((print-it (stream)
-            (/show0 "entering PRINT-IT")
+            (/show0 "entering PRINT-IT in OUTPUT-OBJECT")
             (if *print-pretty*
                 (if *pretty-printer*
                     (funcall *pretty-printer* object stream)