Changeset 9408

Timestamp:

May 8, 2008, 8:05:58 AM (17 years ago)

Author:

gz

Message:

real-print-stream -> %real-print-stream, less redundant streamp checking

Location:

branches/working-0711/ccl/level-1

Files:

• l1-io.lisp (modified) (9 diffs)
• l1-streams.lisp (modified) (2 diffs)

branches/working-0711/ccl/level-1/l1-io.lisp

@@ -35 +35 @@
 
 (defun force-output (&optional stream)
-  (stream-force-output (real-print-stream stream))
+  (stream-force-output (%real-print-stream stream))
   nil)
 
@@ -45 +45 @@
   "Output #\Newline only if the OUTPUT-STREAM is not already at the
 start of a line.  Return T if #\Newline needed."
-  (stream-fresh-line (real-print-stream output-stream)))
-
+  (stream-fresh-line (%real-print-stream output-stream)))
+
+(defun column (&optional stream)
+  (let* ((stream (%real-print-stream stream)))
+    (stream-line-column stream)))
 
 (defun clear-input (&optional input-stream)
@@ -55 +58 @@
 (defun write-char (char &optional (output-stream nil))
   "Output CHAR to OUTPUT-STREAM."
-  (let* ((stream (real-print-stream output-stream)))
+  (let* ((stream (%real-print-stream output-stream)))
     (if (typep stream 'basic-stream)
       (let* ((ioblock (basic-stream-ioblock stream)))
         (funcall (ioblock-write-char-function ioblock) ioblock char))
-      (stream-write-char (real-print-stream output-stream) char))
+      (stream-write-char stream char))
     char))
 
@@ -66 +69 @@
   "Write the characters of the subsequence of STRING bounded by START
 and END to OUTPUT-STREAM."
-  (let* ((stream (real-print-stream output-stream)))
+  (let* ((stream (%real-print-stream output-stream)))
     (if (typep stream 'basic-stream)
       (let* ((ioblock (basic-stream-ioblock stream)))
@@ -95 +98 @@
   "Write the characters of the subsequence of STRING bounded by START
 and END to OUTPUT-STREAM then output a #\Newline at end."
-  (let ((stream (real-print-stream output-stream)))
-    (write-string string stream :start start :end end)
-    (terpri stream)
-    string))
+  (write-string string output-stream :start start :end end)
+  (terpri output-stream)
+  string)
 
 (defun terpri (&optional (stream *standard-output*))
-  (let* ((stream (real-print-stream stream)))
+  (let* ((stream (%real-print-stream stream)))
     (if (typep stream 'basic-stream)
       (let* ((ioblock (basic-stream-ioblock stream)))
         (funcall (ioblock-write-char-function ioblock) ioblock #\newline))
-      (stream-write-char  (real-print-stream stream) #\newline))
+      (stream-write-char stream #\newline))
     nil))
 
@@ -689 +691 @@
   (let ((strlen 0) (exponent-char (float-exponent-char float)))
     (declare (fixnum exp strlen))
-    (setq stream (real-print-stream stream))
+    (setq stream (%real-print-stream stream))
     (if (and (not nanning)(nan-or-infinity-p float))
       (print-a-nan float stream)    
@@ -1674 +1676 @@
         ((streamp stream)
          stream)
+        ;; This never gets called because streamp is true for xp-structure...
         ((istruct-typep stream 'xp-structure)
          (get-xp-stream stream))
@@ -1679 +1682 @@
          (report-bad-arg stream '(or stream (member nil t))))))
 
+(declaim (inline %real-print-stream))
+(defun %real-print-stream (&optional (stream nil))
+  (cond ((null stream)
+         *standard-output*)
+        ((eq stream t)
+         *terminal-io*)
+        (t stream)))
+
 (defun write-1 (object stream &optional levels-left)
-  (setq stream (real-print-stream stream))
+  (setq stream (%real-print-stream stream))
   (when (not levels-left)
     (setq levels-left
@@ -1821 +1832 @@
   "Output a newline, the mostly READable printed representation of OBJECT, and
   space to the specified STREAM."
-  (setq stream (real-print-stream stream))
   (terpri stream)
   (let ((*print-escape* t))

branches/working-0711/ccl/level-1/l1-streams.lisp

@@ -102 +102 @@
 
 (defmethod stream-element-type ((x t))
+  (report-bad-arg x 'stream))
+
+(defmethod stream-force-output ((x t))
   (report-bad-arg x 'stream))
 
@@ -5836 +5839 @@
 
                              
-(defun column (&optional stream)
-  (let* ((stream (real-print-stream stream)))
-    (stream-line-column stream)))        
-
 (defun (setf %ioblock-external-format) (ef ioblock)
   (let* ((encoding (get-character-encoding (external-format-character-encoding ef)))