(*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
(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
;; 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)))
(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)