From 1bdf5761acc2d85fc27ebfe09552a3c6880b13c0 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Wed, 4 Jan 2017 11:43:17 -0500 Subject: [PATCH] Avoid overloaded term "SYNONYM" in regard to any old stream. NIL and T act as stream _designators_, not synonyms. --- contrib/sb-simple-streams/impl.lisp | 44 +++++++++++++++++----------------- contrib/sb-simple-streams/package.lisp | 2 ++ package-data-list.lisp-expr | 2 +- src/code/describe.lisp | 2 +- src/code/pprint.lisp | 8 +++---- src/code/print.lisp | 12 +++++----- src/code/reader.lisp | 8 +++---- src/code/sharpm.lisp | 2 +- src/code/stream.lisp | 22 ++++++++--------- src/code/sysmacs.lisp | 21 ++++++++-------- src/code/target-stream.lisp | 2 +- 11 files changed, 63 insertions(+), 62 deletions(-) diff --git a/contrib/sb-simple-streams/impl.lisp b/contrib/sb-simple-streams/impl.lisp index bb11d6540..bc8c12011 100644 --- a/contrib/sb-simple-streams/impl.lisp +++ b/contrib/sb-simple-streams/impl.lisp @@ -728,7 +728,7 @@ (defun read-byte (stream &optional (eof-error-p t) eof-value) "Returns the next byte of the Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (let ((byte (%read-byte stream eof-error-p eof-value))) @@ -747,7 +747,7 @@ eof-value recursive-p) "Inputs a character from Stream and returns it." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (let ((char (%read-char stream eof-error-p eof-value recursive-p t))) @@ -767,7 +767,7 @@ eof-value recursive-p) "Returns the next character from the Stream if one is availible, or nil." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (%check stream :input) @@ -789,7 +789,7 @@ (defun unread-char (character &optional (stream *standard-input*)) "Puts the Character back on the front of the input Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (%unread-char stream character)) @@ -805,7 +805,7 @@ (eof-error-p t) eof-value recursive-p) "Peeks at the next character in the input Stream. See manual for details." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (let ((char @@ -851,7 +851,7 @@ is supported only on simple-streams." (declare (sb-int:explicit-check)) ;; WIDTH is number of octets which must be available; any value ;; other than 1 is treated as 'character. - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (%listen stream width)) @@ -866,7 +866,7 @@ is supported only on simple-streams." "Returns a line of text read from the Stream as a string, discarding the newline character." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (%read-line stream eof-error-p eof-value recursive-p)) @@ -886,7 +886,7 @@ is supported only on simple-streams." for STREAM is reached before copying all elements of the subsequence, then the extra elements near the end of sequence are not updated, and the index of the next element is returned." - (let ((stream (sb-impl::in-synonym-of stream)) + (let ((stream (in-stream-from-designator stream)) (end (or end (length seq)))) (etypecase stream (simple-stream @@ -900,7 +900,7 @@ is supported only on simple-streams." (defun clear-input (&optional (stream *standard-input*) buffer-only) "Clears any buffered input associated with the Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (simple-stream (%clear-input stream buffer-only)) @@ -913,7 +913,7 @@ is supported only on simple-streams." (defun write-byte (integer stream) "Outputs an octet to the Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%write-byte stream integer)) @@ -926,7 +926,7 @@ is supported only on simple-streams." (defun write-char (character &optional (stream *standard-output*)) "Outputs the Character to the Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%write-char stream character)) @@ -940,7 +940,7 @@ is supported only on simple-streams." &key (start 0) (end nil)) "Outputs the String to the given Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream)) + (let ((stream (out-stream-from-designator stream)) (end (sb-impl::%check-vector-sequence-bounds string start end))) (etypecase stream (simple-stream @@ -955,7 +955,7 @@ is supported only on simple-streams." &key (start 0) end) (declare (type string string)) (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream)) + (let ((stream (out-stream-from-designator stream)) (end (sb-impl::%check-vector-sequence-bounds string start end))) (etypecase stream (simple-stream @@ -973,7 +973,7 @@ is supported only on simple-streams." (defun write-sequence (seq stream &key (start 0) (end nil)) "Write the elements of SEQ bounded by START and END to STREAM." - (let ((stream (sb-impl::out-synonym-of stream)) + (let ((stream (out-stream-from-designator stream)) (end (or end (length seq)))) (etypecase stream (simple-stream @@ -986,7 +986,7 @@ is supported only on simple-streams." (defun terpri (&optional (stream *standard-output*)) "Outputs a new line to the Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%check stream :output) @@ -1002,7 +1002,7 @@ is supported only on simple-streams." "Outputs a new line to the Stream if it is not positioned at the beginning of a line. Returns T if it output a new line, nil otherwise." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%fresh-line stream)) @@ -1015,7 +1015,7 @@ is supported only on simple-streams." "Attempts to ensure that all output sent to the Stream has reached its destination, and only then returns." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%finish-output stream)) @@ -1028,7 +1028,7 @@ is supported only on simple-streams." (defun force-output (&optional (stream *standard-output*)) "Attempts to force any buffered output to be sent." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%force-output stream)) @@ -1041,7 +1041,7 @@ is supported only on simple-streams." (defun clear-output (&optional (stream *standard-output*)) "Clears the given output Stream." (declare (sb-int:explicit-check)) - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%clear-output stream)) @@ -1076,7 +1076,7 @@ is supported only on simple-streams." (defun charpos (&optional (stream *standard-output*)) "Returns the number of characters on the current line of output of the given Stream, or Nil if that information is not availible." - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (with-stream-class (simple-stream stream) @@ -1090,7 +1090,7 @@ is supported only on simple-streams." (defun line-length (&optional (stream *standard-output*)) "Returns the number of characters in a line of output of the given Stream, or Nil if that information is not availible." - (let ((stream (sb-impl::out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (etypecase stream (simple-stream (%check stream :output) @@ -1106,7 +1106,7 @@ is supported only on simple-streams." (defun wait-for-input-available (stream &optional timeout) "Waits for input to become available on the Stream and returns T. If Timeout expires, Nil is returned." - (let ((stream (sb-impl::in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (etypecase stream (fixnum (sb-sys:wait-until-fd-usable stream :input timeout)) diff --git a/contrib/sb-simple-streams/package.lisp b/contrib/sb-simple-streams/package.lisp index f2972f7af..99b59b4c8 100644 --- a/contrib/sb-simple-streams/package.lisp +++ b/contrib/sb-simple-streams/package.lisp @@ -11,6 +11,8 @@ (:use #:common-lisp) (:import-from #:sb-kernel #:ansi-stream #:charpos #:line-length) (:import-from #:sb-gray #:fundamental-stream) + (:import-from #:sb-impl + #:in-stream-from-designator #:out-stream-from-designator) #+sb-package-locks ;; FIXME: Using deffoo! or equivalent might be nicer. (:implement #:common-lisp #:sb-kernel #:sb-int) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 151cb4f88..9c725652a 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1340,7 +1340,7 @@ possibly temporarily, because it might be used internally." "%INTERN" "WITH-FAST-READ-BYTE" "PREPARE-FOR-FAST-READ-CHAR" - "OUT-SYNONYM-OF" + "OUT-STREAM-FROM-DESIGNATOR" "STRINGIFY-OBJECT" "%WRITE" diff --git a/src/code/describe.lisp b/src/code/describe.lisp index e69409d38..d258d0cc8 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -88,7 +88,7 @@ (defun describe (object &optional (stream-designator *standard-output*)) #+sb-doc "Print a description of OBJECT to STREAM-DESIGNATOR." - (let ((stream (out-synonym-of stream-designator)) + (let ((stream (out-stream-from-designator stream-designator)) (*print-right-margin* (or *print-right-margin* 72)) (*print-circle* t) (*suppress-print-errors* diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index d06aa090c..92ab2f085 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -602,7 +602,7 @@ (declare (type (member :linear :miser :fill :mandatory) kind) (type stream-designator stream) (values null)) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (when (print-pretty-on-stream-p stream) (enqueue-newline stream kind))) nil) @@ -626,7 +626,7 @@ line break." (type real n) (type stream-designator stream) (values null)) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (when (print-pretty-on-stream-p stream) (enqueue-indent stream relative-to (truncate n)))) nil) @@ -648,7 +648,7 @@ line break." (type unsigned-byte colnum colinc) (type stream-designator stream) (values null)) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (when (print-pretty-on-stream-p stream) (enqueue-tab stream kind colnum colinc))) nil) @@ -1376,7 +1376,7 @@ line break." ;; a non-list object which bypasses START-LOGICAL-BLOCK. ;; Also, START-LOGICAL-BLOCK could become an FLET inside here. (declare (function proc)) - (with-pretty-stream (stream (out-synonym-of stream)) + (with-pretty-stream (stream (out-stream-from-designator stream)) (if (or (not (listp object)) ; implies obj-supplied-p (and (eq (car object) 'quasiquote) ;; We can only bail out from printing this logical block diff --git a/src/code/print.lisp b/src/code/print.lisp index 84cc12b5a..b4438cd2b 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -134,7 +134,7 @@ variable: an unreadable object representing the error is printed instead.") ,@forms))) (def write "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*." - (output-object object (out-synonym-of stream)) + (output-object object (out-stream-from-designator stream)) object) (def write-to-string "Return the printed representation of OBJECT as a string." @@ -143,7 +143,7 @@ variable: an unreadable object representing the error is printed instead.") ;;; Same as a call to (WRITE OBJECT :STREAM STREAM), but returning OBJECT. (defun %write (object stream) (declare (explicit-check)) - (output-object object (out-synonym-of stream)) + (output-object object (out-stream-from-designator stream)) object) (defun prin1 (object &optional stream) @@ -152,7 +152,7 @@ variable: an unreadable object representing the error is printed instead.") STREAM." (declare (explicit-check)) (let ((*print-escape* t)) - (output-object object (out-synonym-of stream))) + (output-object object (out-stream-from-designator stream))) object) (defun princ (object &optional stream) @@ -162,7 +162,7 @@ variable: an unreadable object representing the error is printed instead.") (declare (explicit-check)) (let ((*print-escape* nil) (*print-readably* nil)) - (output-object object (out-synonym-of stream))) + (output-object object (out-stream-from-designator stream))) object) (defun print (object &optional stream) @@ -170,7 +170,7 @@ variable: an unreadable object representing the error is printed instead.") "Output a newline, the mostly READable printed representation of OBJECT, and space to the specified STREAM." (declare (explicit-check)) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (terpri stream) (prin1 object stream) (write-char #\space stream) @@ -182,7 +182,7 @@ variable: an unreadable object representing the error is printed instead.") (declare (explicit-check)) (let ((*print-pretty* t) (*print-escape* t) - (stream (out-synonym-of stream))) + (stream (out-stream-from-designator stream))) (terpri stream) (output-object object stream)) (values)) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 3d404ec8d..9cf125cf9 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -426,7 +426,7 @@ standard Lisp readtable when NIL." (defun flush-whitespace (stream) ;; This flushes whitespace chars, returning the last char it read (a ;; non-white one). It always gets an error on end-of-file. - (let* ((stream (in-synonym-of stream)) + (let* ((stream (in-stream-from-designator stream)) (rt *readtable*) (attribute-array (character-attribute-array rt)) (attribute-hash-table (character-attribute-hash-table rt))) @@ -791,7 +791,7 @@ standard Lisp readtable when NIL." 'sb!kernel::character-decoding-error-in-macro-char-comment :position (file-position stream) :stream stream) (invoke-restart 'attempt-resync)))) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (loop (let ((char (fast-read-char nil +EOF+))) @@ -943,7 +943,7 @@ standard Lisp readtable when NIL." (let* ((token-buf *read-buffer*) (buf (token-buf-string token-buf)) (rt *readtable*) - (stream (in-synonym-of stream)) + (stream (in-stream-from-designator stream)) (suppress *read-suppress*) (lim (length buf)) (ptr 0) @@ -1457,7 +1457,7 @@ extended :: syntax." (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) SYMBOL ; not a dot, dots, or number - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (macrolet ((scan (read-a-char &optional finish) `(prog () diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp index 932ddcada..285c06c3f 100644 --- a/src/code/sharpm.lisp +++ b/src/code/sharpm.lisp @@ -383,7 +383,7 @@ 'sb!kernel::character-decoding-error-in-dispatch-macro-char-comment :sub-char sub-char :position (file-position stream) :stream stream) (invoke-restart 'attempt-resync)))) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (macrolet ((munch (get-char &optional finish) `(do ((level 1) (prev ,get-char char) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index b18dc4f81..d0847b35e 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -341,7 +341,7 @@ (defun read-line (&optional (stream *standard-input*) (eof-error-p t) eof-value recursive-p) (declare (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-read-line stream eof-error-p eof-value recursive-p) ;; must be Gray streams FUNDAMENTAL-STREAM @@ -367,7 +367,7 @@ eof-value recursive-p) (declare (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-read-char stream eof-error-p eof-value recursive-p) ;; must be Gray streams FUNDAMENTAL-STREAM @@ -395,7 +395,7 @@ (defun unread-char (character &optional (stream *standard-input*)) (declare (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-unread-char character stream) ;; must be Gray streams FUNDAMENTAL-STREAM @@ -414,7 +414,7 @@ (defun listen (&optional (stream *standard-input*)) (declare (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-listen stream) ;; Fall through to Gray streams FUNDAMENTAL-STREAM case. @@ -432,7 +432,7 @@ eof-value recursive-p) (declare (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-read-char-no-hang stream eof-error-p eof-value recursive-p) @@ -449,7 +449,7 @@ (defun clear-input (&optional (stream *standard-input*)) (declare (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-clear-input stream) ;; must be Gray streams FUNDAMENTAL-STREAM @@ -660,7 +660,7 @@ (defun fresh-line (&optional (stream *standard-output*)) (declare (explicit-check)) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-fresh-line stream) ;; must be Gray streams FUNDAMENTAL-STREAM @@ -675,7 +675,7 @@ stream data offset-start offset-end))) (defun %write-string (string stream start end) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-write-string string stream start end) ;; must be Gray streams FUNDAMENTAL-STREAM @@ -694,7 +694,7 @@ (declare (type string string)) (declare (type stream-designator stream)) (declare (explicit-check)) - (let ((stream (out-synonym-of stream))) + (let ((stream (out-stream-from-designator stream))) (cond ((ansi-stream-p stream) (ansi-stream-write-string string stream start end) (funcall (ansi-stream-out stream) stream #\newline)) @@ -730,8 +730,8 @@ (defun write-byte (integer stream) (declare (explicit-check)) - (with-out-stream/no-synonym stream (ansi-stream-bout integer) - (stream-write-byte integer)) + ;; The STREAM argument is not allowed to be a designator. + (%with-out-stream stream (ansi-stream-bout integer) (stream-write-byte integer)) integer) diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index 830971594..4013f6206 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -85,14 +85,12 @@ maintained." ;;; These macros handle the special cases of T and NIL for input and ;;; output streams. -;;; It is unfortunate that the names connote synonym-streams being involved. -;;; Perhaps {IN,OUT}-STREAM-FROM-DESIGNATOR would have been better. -;;; And shouldn't the high-security feature check that if either NIL or T -;;; is given, the designated stream has the right directionality? -;;; Nothing prevents *TERMINAL-IO* from being bound to an output-only stream. +;;; FIXME: should we kill the high-security feature? Or, if enabled, +;;; ensure that the designated stream has the right directionality? +;;; (Nothing prevents *TERMINAL-IO* from being bound to an output-only stream, e.g.) ;;; ;;; FIXME: Shouldn't these be functions instead of macros? -(defmacro in-synonym-of (stream) +(defmacro in-stream-from-designator (stream) (let ((svar (gensym))) `(let ((,svar ,stream)) (cond ((null ,svar) *standard-input*) @@ -117,7 +115,7 @@ maintained." ((t) '*terminal-io*) (t (return x)))))) |# -(defmacro out-synonym-of (stream) +(defmacro out-stream-from-designator (stream) (let ((svar (gensym))) `(let ((,svar ,stream)) (cond ((null ,svar) *standard-output*) @@ -136,7 +134,7 @@ maintained." ;;; STREAM with the ARGS for ANSI-STREAMs, or the FUNCTION with the ;;; ARGS for FUNDAMENTAL-STREAMs. (defmacro with-in-stream (stream (slot &rest args) &optional stream-dispatch) - `(let ((stream (in-synonym-of ,stream))) + `(let ((stream (in-stream-from-designator ,stream))) ,(if stream-dispatch `(if (ansi-stream-p stream) (funcall (,slot stream) stream ,@args) @@ -145,7 +143,7 @@ maintained." `(,function stream ,@args))))) `(funcall (,slot stream) stream ,@args)))) -(defmacro with-out-stream/no-synonym (stream (slot &rest args) &optional stream-dispatch) +(defmacro %with-out-stream (stream (slot &rest args) &optional stream-dispatch) `(let ((stream ,stream)) ,(if stream-dispatch `(if (ansi-stream-p stream) @@ -156,8 +154,9 @@ maintained." `(funcall (,slot stream) stream ,@args)))) (defmacro with-out-stream (stream (slot &rest args) &optional stream-dispatch) - `(with-out-stream/no-synonym (out-synonym-of ,stream) - (,slot ,@args) ,stream-dispatch)) + `(%with-out-stream (out-stream-from-designator ,stream) + (,slot ,@args) + ,stream-dispatch)) ;;;; These are hacks to make the reader win. diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp index 15043dc6c..f4dfadb4c 100644 --- a/src/code/target-stream.lisp +++ b/src/code/target-stream.lisp @@ -89,7 +89,7 @@ eof-value recursive-p) (declare (type (or character boolean) peek-type) (explicit-check)) - (let ((stream (in-synonym-of stream))) + (let ((stream (in-stream-from-designator stream))) (if (ansi-stream-p stream) (ansi-stream-peek-char peek-type stream eof-error-p eof-value recursive-p) -- 2.11.4.GIT