Changeset 9408


Ignore:
Timestamp:
May 8, 2008, 3:05:58 PM (11 years ago)
Author:
gz
Message:

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

Location:
branches/working-0711/ccl/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-io.lisp

    r8919 r9408  
    3535
    3636(defun force-output (&optional stream)
    37   (stream-force-output (real-print-stream stream))
     37  (stream-force-output (%real-print-stream stream))
    3838  nil)
    3939
     
    4545  "Output #\Newline only if the OUTPUT-STREAM is not already at the
    4646start of a line.  Return T if #\Newline needed."
    47   (stream-fresh-line (real-print-stream output-stream)))
    48 
     47  (stream-fresh-line (%real-print-stream output-stream)))
     48
     49(defun column (&optional stream)
     50  (let* ((stream (%real-print-stream stream)))
     51    (stream-line-column stream)))
    4952
    5053(defun clear-input (&optional input-stream)
     
    5558(defun write-char (char &optional (output-stream nil))
    5659  "Output CHAR to OUTPUT-STREAM."
    57   (let* ((stream (real-print-stream output-stream)))
     60  (let* ((stream (%real-print-stream output-stream)))
    5861    (if (typep stream 'basic-stream)
    5962      (let* ((ioblock (basic-stream-ioblock stream)))
    6063        (funcall (ioblock-write-char-function ioblock) ioblock char))
    61       (stream-write-char (real-print-stream output-stream) char))
     64      (stream-write-char stream char))
    6265    char))
    6366
     
    6669  "Write the characters of the subsequence of STRING bounded by START
    6770and END to OUTPUT-STREAM."
    68   (let* ((stream (real-print-stream output-stream)))
     71  (let* ((stream (%real-print-stream output-stream)))
    6972    (if (typep stream 'basic-stream)
    7073      (let* ((ioblock (basic-stream-ioblock stream)))
     
    9598  "Write the characters of the subsequence of STRING bounded by START
    9699and END to OUTPUT-STREAM then output a #\Newline at end."
    97   (let ((stream (real-print-stream output-stream)))
    98     (write-string string stream :start start :end end)
    99     (terpri stream)
    100     string))
     100  (write-string string output-stream :start start :end end)
     101  (terpri output-stream)
     102  string)
    101103
    102104(defun terpri (&optional (stream *standard-output*))
    103   (let* ((stream (real-print-stream stream)))
     105  (let* ((stream (%real-print-stream stream)))
    104106    (if (typep stream 'basic-stream)
    105107      (let* ((ioblock (basic-stream-ioblock stream)))
    106108        (funcall (ioblock-write-char-function ioblock) ioblock #\newline))
    107       (stream-write-char  (real-print-stream stream) #\newline))
     109      (stream-write-char stream #\newline))
    108110    nil))
    109111
     
    689691  (let ((strlen 0) (exponent-char (float-exponent-char float)))
    690692    (declare (fixnum exp strlen))
    691     (setq stream (real-print-stream stream))
     693    (setq stream (%real-print-stream stream))
    692694    (if (and (not nanning)(nan-or-infinity-p float))
    693695      (print-a-nan float stream)   
     
    16741676        ((streamp stream)
    16751677         stream)
     1678        ;; This never gets called because streamp is true for xp-structure...
    16761679        ((istruct-typep stream 'xp-structure)
    16771680         (get-xp-stream stream))
     
    16791682         (report-bad-arg stream '(or stream (member nil t))))))
    16801683
     1684(declaim (inline %real-print-stream))
     1685(defun %real-print-stream (&optional (stream nil))
     1686  (cond ((null stream)
     1687         *standard-output*)
     1688        ((eq stream t)
     1689         *terminal-io*)
     1690        (t stream)))
     1691
    16811692(defun write-1 (object stream &optional levels-left)
    1682   (setq stream (real-print-stream stream))
     1693  (setq stream (%real-print-stream stream))
    16831694  (when (not levels-left)
    16841695    (setq levels-left
     
    18211832  "Output a newline, the mostly READable printed representation of OBJECT, and
    18221833  space to the specified STREAM."
    1823   (setq stream (real-print-stream stream))
    18241834  (terpri stream)
    18251835  (let ((*print-escape* t))
  • branches/working-0711/ccl/level-1/l1-streams.lisp

    r9242 r9408  
    102102
    103103(defmethod stream-element-type ((x t))
     104  (report-bad-arg x 'stream))
     105
     106(defmethod stream-force-output ((x t))
    104107  (report-bad-arg x 'stream))
    105108
     
    58365839
    58375840                             
    5838 (defun column (&optional stream)
    5839   (let* ((stream (real-print-stream stream)))
    5840     (stream-line-column stream)))       
    5841 
    58425841(defun (setf %ioblock-external-format) (ef ioblock)
    58435842  (let* ((encoding (get-character-encoding (external-format-character-encoding ef)))
Note: See TracChangeset for help on using the changeset viewer.