;;; -*- Lisp -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC). 
;;; **********************************************************************
;;;
;;; Stream functions for Spice Lisp.
;;; Written by Skef Wholey and Rob MacLachlan.
;;;
;;; This file contains the machine-independent stream functions.  Another
;;; file (VAXIO, SPIO, or VMIO) contains functions used by this file for
;;; a specific machine.
;;;

;;;; Broadcast streams:

(defstruct (broadcast-stream (:include stream
				       (out #'broadcast-out)
				       (bout #'broadcast-bout)
				       (sout #'broadcast-sout)
				       (misc #'broadcast-misc)
				       (charpos #'broadcast-charpos))
			     (:print-function %print-broadcast-stream)
			     (:constructor make-broadcast-stream (&rest streams)))
  ;; This is a list of all the streams we broadcast to.
  streams)

(setf (documentation 'make-broadcast-stream 'function)
 "Returns an ouput stream which sends its output to all of the given streams.")

(defun %print-broadcast-stream (s stream d)
  (declare (ignore s d))
  (write-string "#<Broadcast Stream>" stream))

(defun broadcast-out (stream out-goer)
  (dolist (stream (broadcast-stream-streams stream))
    (funcall (stream-out stream) stream out-goer)))

(defun broadcast-bout (stream out-goer)
  (dolist (stream (broadcast-stream-streams stream))
    (funcall (stream-bout stream) stream out-goer)))

(defun broadcast-sout (stream out-goer start end)
  (dolist (stream (broadcast-stream-streams stream))
    (funcall (stream-sout stream) stream out-goer start end)))

(defun broadcast-misc (stream operation abort-flag)
  (case operation
    (:element-type
     (let (res)
       (dolist (stream (broadcast-stream-streams stream) 
		       (if (> (length res) 1) `(and ,@res) res))
	 (pushnew (funcall (stream-misc stream) stream :element-type nil) res
		  :test #'equal))))
    (:line-length
     (let (max res)
       (dolist (stream (broadcast-stream-streams stream) max)
	 (setq res (funcall (stream-misc stream) stream :line-length nil))
	 (when res (setq max (if max (max max res) res))))))
    (:close
     (dolist (stream (broadcast-stream-streams stream))
       (funcall (stream-misc stream) stream :close abort-flag)))))

(defun broadcast-charpos (stream)
  (dolist (stream (broadcast-stream-streams stream))
    (let ((charpos (funcall (stream-charpos stream) stream)))
      (if charpos (return charpos)))))

;;;; Synonym Streams:

(defstruct (synonym-stream (:include stream
				     (in #'synonym-in)
				     (bin #'synonym-bin)
				     (readline #'synonym-readline)
				     (n-bin #'synonym-n-bin)
				     (out #'synonym-out)
				     (bout #'synonym-bout)
				     (sout #'synonym-sout)
				     (misc #'synonym-misc)
				     (listen #'synonym-listen)
				     (charpos #'synonym-charpos))
			   (:print-function %print-synonym-stream)
			   (:constructor make-synonym-stream (symbol)))
  ;; This is the symbol, the value of which is the stream we are synonym to.
  symbol)

(defun %print-synonym-stream (s stream d)
  (declare (ignore d))
  (format stream "#<Synonym Stream to ~S>" (synonym-stream-symbol s)))

(setf (documentation 'make-synonym-stream 'function)
  "Returns a stream which performs its operations on the stream which is the
   value of the dynamic variable named by Symbol.")

(eval-when (compile eval)
(defmacro synonym-magic (stream slot &rest args)
  `(let ((stream (symbol-value (synonym-stream-symbol ,stream))))
     (funcall (,slot stream) stream ,@args)))
); eval-when (compile eval)

(defun synonym-in (stream eof-errorp eof-value)
  (synonym-magic stream stream-in eof-errorp eof-value))
(defun synonym-bin (stream eof-errorp eof-value)
  (synonym-magic stream stream-bin eof-errorp eof-value))
(defun synonym-readline (stream eof-errorp eof-value)
  (synonym-magic stream stream-readline eof-errorp eof-value))
(defun synonym-n-bin (stream buffer eof-errorp eof-value)
  (synonym-magic stream stream-n-bin buffer eof-errorp eof-value))
(defun synonym-out (stream ch) (synonym-magic stream stream-out ch))
(defun synonym-bout (stream n) (synonym-magic stream stream-bout n))
(defun synonym-sout (stream string start end)
  (synonym-magic stream stream-sout string start end))
(defun synonym-misc (stream operation abort-flag)
  (synonym-magic stream stream-misc operation abort-flag))
(defun synonym-listen (stream) (synonym-magic stream stream-listen))
(defun synonym-charpos (stream) (synonym-magic stream stream-charpos))

;;;; Two-Way streams:

(defstruct (two-way-stream
	    (:include stream
		      (in #'two-way-in)
		      (bin #'two-way-bin)
		      (readline #'two-way-readline)
		      (n-bin #'two-way-n-bin)
		      (out #'two-way-out)
		      (bout #'two-way-bout)
		      (sout #'two-way-sout)
		      (misc #'two-way-misc)
		      (listen #'two-way-listen)
		      (charpos #'two-way-charpos))
	    (:print-function %print-two-way-stream)
	    (:constructor make-two-way-stream (input-stream output-stream)))
  ;; We read from this stream...
  input-stream
  ;; And write to this one
  output-stream)

(defun %print-two-way-stream (s stream d)
  (declare (ignore d))
  (format stream "#<Two-Way Stream, Input = ~S, Output = ~S>"
	  (two-way-stream-input-stream s)
	  (two-way-stream-output-stream s)))

(setf (documentation 'make-two-way-stream 'function)
  "Returns a bidirectional stream which gets its input from Input-Stream and
   sends its output to Output-Stream.")

(eval-when (compile eval)
(defmacro two-way-input (name slot &rest args)
  `(defun ,name (stream ,@args)
     (setq stream (two-way-stream-input-stream stream))
     (funcall (,slot stream) stream ,@args)))
(defmacro two-way-output (name slot &rest args)
  `(defun ,name (stream ,@args)
     (setq stream (two-way-stream-output-stream stream))
     (funcall (,slot stream) stream ,@args)))
); eval-when (compile eval)

(two-way-input two-way-in stream-in eof-errorp eof-value)
(two-way-input two-way-bin stream-bin eof-errorp eof-value)
(two-way-input two-way-readline stream-readline eof-errorp eof-value)
(two-way-input two-way-n-bin stream-n-bin)
(two-way-output two-way-out stream-out)
(two-way-output two-way-bout stream-bout)
(two-way-output two-way-sout stream-sout)
(defun two-way-misc (stream operation abort-flag)
  (let* ((in (two-way-stream-input-stream stream))
	 (in-method (stream-misc in))
	 (out (two-way-stream-output-stream stream))
	 (out-method (stream-misc out)))
    (case operation
      (:element-type
       (let ((in-type (funcall in-method in :element-type nil))
	     (out-type (funcall out-method out :element-type nil)))
	 (if (equal in-type out-type)
	     in-type `(and ,in-type ,out-type))))
      (:line-length
       (funcall out-method out :line-length nil))
      (:close
       (funcall in-method in :close abort-flag)
       (funcall out-method out :close abort-flag))
      (:clear-input
       (funcall in-method in :clear-input))
      (t
       (funcall out-method out operation nil)))))
(two-way-input two-way-listen stream-listen)
(two-way-output two-way-charpos stream-charpos)

;;;; Concatenated Streams:

(defstruct (concatenated-stream
	    (:include stream
		      (in #'concatenated-in)
		      (bin #'concatenated-bin)
		      (readline #'concatenated-readline)
		      (misc #'concatenated-misc)
		      (listen #'concatenated-listen))
	    (:print-function %print-concatenated-stream)
	    (:constructor
	     make-concatenated-stream (&rest streams &aux (current streams))))
  ;; The car of this is the stream we are reading from now.
  current
  ;; This is a list of all the streams.  We need to remember them so that
  ;; we can close them.
  streams)

(defun %print-concatenated-stream (s stream d)
  (declare (ignore d))
  (format stream "#<Concatenated Stream, Streams = ~S>"
	  (concatenated-stream-streams s)))

(setf (documentation 'make-concatenated-stream 'function)
  "Returns a stream which takes its input from each of the Streams in turn,
   going on to the next at EOF.")

(eval-when (compile eval)
(defmacro concatenated-frob (name slot)
  `(defun ,name (stream eof-errorp eof-value)
     (do ((current (concatenated-stream-current stream) (cdr current)))
	 ((null current)
	  (eof-or-lose stream eof-errorp eof-value))
       (let* ((stream (car current))
	      (result (funcall (,slot stream) stream nil nil)))
	 (when result (return result)))
       (setf (concatenated-stream-current stream) current))))
); eval-when (compile eval)
(concatenated-frob concatenated-in stream-in)
(concatenated-frob concatenated-bin stream-bin)

;;;    Concatenated-Readline is somewhat hairy, since we may need to
;;; do several readlines and concatenate the result if the lines are
;;; terminated by eof.
;;;
(defun concatenated-readline (stream eof-errorp eof-value)
  ;; Loop until we find a stream that will give us something or we error
  ;; out.
  (do ((current (concatenated-stream-current stream) (cdr current)))
      ((null current)
       (eof-or-lose stream eof-errorp eof-value))
    (setf (concatenated-stream-current stream) current)
    (let ((this (car current)))
      (multiple-value-bind (result eofp)
			   (funcall (stream-readline this) this nil nil)
	(declare (simple-string result))
	;; Once we have found some input, we loop until we either find a 
	;; line not terminated by eof or hit eof on the last stream.
	(when result
	  (do ((current (cdr current) (cdr current)) new)
	      ((or (not eofp) (null current))
	       (return-from concatenated-readline (values result eofp)))
	    (declare (simple-string new))
	    (setf (concatenated-stream-current stream) current)
	    (let ((this (car current)))
	      (multiple-value-setq (new eofp)
		(funcall (stream-readline this) this nil nil))
	      (if new
		  (setq result (concatenate 'simple-string result new))
		  (setq eofp t)))))))))

(defun concatenated-listen (stream)
  (dolist (stream (concatenated-stream-current stream))
    (when (funcall (stream-listen stream) stream) (return t))))

(defun concatenated-misc (stream operation abort-flag)
  (case operation
    ((:clear-input :element-type :line-length)
     (let ((stream (concatenated-stream-current stream)))
       (when stream
	 (funcall (stream-misc stream) stream operation nil))))
    (:close
     (dolist (stream (concatenated-stream-streams stream))
       (funcall (stream-misc stream) stream :close abort-flag)))))

;;;; Echo Streams:

(defstruct (echo-stream
	    (:include two-way-stream
		      (in #'echo-in)
		      (bin #'echo-bin)
		      (readline #'echo-readline)
		      (n-bin #'ill-bin))
	    (:print-function %print-echo-stream)
	    (:constructor make-echo-stream (input-stream output-stream))))

(defun %print-echo-stream (s stream d)
  (declare (ignore d))
  (format stream "#<Echo Stream, Input = ~S, Output = ~S>"
	  (two-way-stream-input-stream s)
	  (two-way-stream-output-stream s)))

(setf (documentation 'make-echo-stream 'function)
  "Returns a bidirectional stream which gets its input from Input-Stream and
   sends its output to Output-Stream.  In addition, all input is echoed to
   the output stream")

(eval-when (compile eval)
(defmacro echo-input (name slot echo-op &rest args)
  `(defun ,name (stream ,@args)
     (setq stream (two-way-stream-input-stream stream))
     (let ((result (funcall (,slot stream) stream ,@args)))
       (,echo-op result (two-way-stream-input-stream stream))
       result)))
); eval-when (compile eval)

(echo-input echo-in stream-in write-char eof-errorp eof-value)
(echo-input echo-bin stream-bin write-byte eof-errorp eof-value)
(defun echo-readline (stream eof-errorp eof-value)
  (setq stream (two-way-stream-input-stream stream))
  (multiple-value-bind (result eofp)
	       (funcall (stream-readline stream) stream eof-errorp eof-value)
    (setq stream (two-way-stream-output-stream stream))
    (if eofp
	(write-string result stream)
	(write-line result stream))
    (values result eofp)))

;;;; String Input Streams:

(defstruct (string-input-stream
	    (:include stream
		      (in #'string-inch)
		      (readline #'string-readline)
		      (listen #'string-listen)
		      (misc #'string-misc))
	    (:print-function %print-string-input-stream)
	    (:constructor internal-make-string-input-stream (string current end)))
  string
  current
  end)

(defun %print-string-input-stream (s stream d)
  (declare (ignore s d))
  (write-string "#<String-Input Stream>" stream))
  
(defun string-readline (stream eof-errorp eof-value)
  (let ((string (string-input-stream-string stream))
	(current (string-input-stream-current stream))
	(end (string-input-stream-end stream)))
    (declare (simple-string string) (fixnum current end))
    (if (= current end)
	(eof-or-lose stream eof-errorp eof-value)
	(let ((pos (%sp-find-character string current end #\newline)))
	  (if pos
	      (let* ((res-length (- pos current))
		     (result (make-string res-length)))
		(%sp-byte-blt string current result 0 res-length)
		(setf (string-input-stream-current stream) (1+ pos))
		(values result nil))
	      (let* ((res-length (- end current))
		     (result (make-string res-length)))
		(%sp-byte-blt string current result 0 res-length)
		(setf (string-input-stream-current stream) end)
		(values result t)))))))

(defun string-inch (stream eof-errorp eof-value)
  (let ((string (string-input-stream-string stream))
	(index (string-input-stream-current stream)))
    (declare (simple-string string) (fixnum index))
    (cond ((= index (string-input-stream-end stream))
	   (eof-or-lose stream eof-errorp eof-value))
	  (t
	   (setf (string-input-stream-current stream) (1+ index))
	   (aref string index)))))

(defun string-listen (stream)
  (not (= (the fixnum (string-input-stream-current stream))
	  (the fixnum (string-input-stream-end stream)))))

(defun string-misc (stream operation abort-flag)
  (declare (ignore stream abort-flag))
  (when (eq operation :element-type) 'string-char))
  
(defun make-string-input-stream (string &optional
					(start 0) (end (length string)))
  "Returns an input stream which will supply the characters of String between
  Start and End in order."
  (if (stringp string)
      (internal-make-string-input-stream (coerce string 'simple-string)
					 start end)
      (error "~S is not a string." string)))

;;;; String Output Streams:

(defstruct (string-output-stream
	    (:include stream
		      (out #'string-ouch)
		      (sout #'string-sout)
		      (charpos #'string-charpos)
		      (misc #'string-misc))
	    (:print-function %print-string-output-stream)
	    (:constructor make-string-output-stream ()))
  ;; The string we throw stuff in.
  (string (make-string 40))
  ;; Index of the next location to use.
  (index 0))

(defun %print-string-output-stream (s stream d)
  (declare (ignore s d))
  (write-string "#<String-Output Stream>" stream))

(setf (documentation 'make-string-output-stream 'function)
  "Returns an Output stream which will accumulate all output given it for
   the benefit of the function Get-Output-Stream-String.")

(defun string-ouch (stream character)
  (let ((current (string-output-stream-index stream))
	(workspace (string-output-stream-string stream)))
    (declare (simple-string workspace) (fixnum current))
    (if (= current (length workspace))
	(let ((new-workspace (make-string (* current 2))))
	  (%sp-byte-blt workspace 0 new-workspace 0 current)
	  (setf (aref new-workspace current) character)
	  (setf (string-output-stream-string stream) new-workspace))
	(setf (aref workspace current) character))
    (setf (string-output-stream-index stream) (1+ current))))

(defun string-sout (stream string start end)
  (declare (fixnum start end))
  (let* ((current (string-output-stream-index stream))
	 (length (- end start))
	 (dst-end (+ length current))
	 (workspace (string-output-stream-string stream)))
    (declare (simple-string workspace string))
    (declare (fixnum current length dst-end start end))
    (if (> dst-end (length workspace))
	(let ((new-workspace (make-string (+ (* current 2) length))))
	  (%sp-byte-blt workspace 0 new-workspace 0 current)
	  (%sp-byte-blt string start new-workspace current dst-end)
	  (setf (string-output-stream-string stream) new-workspace))
	(%sp-byte-blt string start workspace current dst-end))
    (setf (string-output-stream-index stream) dst-end)))

(defun string-charpos (stream)
  (do ((index (string-output-stream-index stream) (1- index))
       (count 0 (1+ count))
       (string (string-output-stream-string stream)))
      ((= index 0) count)
    (declare (simple-string string))
    (if (char= (aref string index) #\newline)
	(return count))))

(defun get-output-stream-string (stream)
  "Returns a string of all the characters sent to a stream made by
   Make-String-Output-Stream since the last call to this function."
  (if (streamp stream)
      (let* ((length (string-output-stream-index stream))
	     (result (make-string length)))
	(%sp-byte-blt (string-output-stream-string stream) 0
		      result 0 length)
	(setf (string-output-stream-index stream) 0)
	result)
      (error "~S is not a string stream.")))

(defun dump-output-stream-string (in-stream out-stream)
  "Dumps the characters buffer up in the In-Stream to the Out-Stream as
  Get-Output-Stream-String would return them."
  (write-string (string-output-stream-string in-stream) out-stream
		0 (string-output-stream-index in-stream))
  (setf (string-output-stream-index in-stream) 0))

(defun input-stream-p (stream)
  "Returns non-nil if the given Stream can perform input operations."
  (and (streamp stream)
       (not (eq (stream-readline stream) #'closed-flame))
       (or (not (eq (stream-in stream) #'ill-in))
	   (not (eq (stream-bin stream) #'ill-in)))))

(defun output-stream-p (stream)
  "Returns non-nil if the given Stream can perform output operations."
  (and (streamp stream)
       (not (eq (stream-readline stream) #'closed-flame))
       (or (not (eq (stream-out stream) #'ill-out))
	   (not (eq (stream-bout stream) #'ill-out)))))

(defun stream-element-type (stream)
  "Returns a type specifier for the kind of object returned by the Stream."
  (funcall (stream-misc stream) stream :element-type nil))

(defun close (stream &key abort)
  "Closes the given Stream.  No more I/O may be performed, but inquiries
  may still be made.  If :Abort is non-nil, an attempt is made to clean
  up the side effects of having created the stream."
  (if (streamp stream)
      (unless (eq (stream-readline stream) #'closed-flame)
	(funcall (stream-misc stream) stream :close abort)
	(setf (stream-readline stream) #'closed-flame)
	(setf (stream-in stream) #'closed-flame)
	(setf (stream-bin stream) #'closed-flame)
	(setf (stream-n-bin stream) #'closed-flame)
	(setf (stream-listen stream) #'closed-flame)
	(setf (stream-in stream) #'closed-flame)
	(setf (stream-out stream) #'closed-flame)
	(setf (stream-bout stream) #'closed-flame)
	(setf (stream-sout stream) #'closed-flame)
	(setf (stream-charpos stream) #'closed-flame)
	(setf (stream-misc stream) #'closed-flame))
      (error "~S is not a stream." stream))
  t)

;;; Input functions:

(defun read-line (&optional (stream *standard-input*) (eof-errorp t) eof-value
			    recursive-p)
  "Returns a line of text read from the Stream as a string, discarding the
  newline character."
  (declare (ignore recursive-p))
  (let* ((stream (in-synonym-of stream))
	 (buffer (stream-peek-buffer stream))
	 (index (stream-peek-index stream))
	 (nl (%sp-find-character buffer index peek-buffer-length #\newline)))
    (declare (simple-string buffer))
    (if nl
	(values (prog1 (subseq buffer index nl)
		       (setf (stream-peek-index stream) (1+ nl)))
		nil)
	(multiple-value-bind (str eofp)
			     (funcall (stream-readline stream)
				      stream eof-errorp eof-value)
	  (declare (simple-string str))
	  (if (= index peek-buffer-length)
	      (values str eofp)
	      (values (prog1
		       (concatenate 'simple-string
				    (subseq buffer index peek-buffer-length)
				    str)
		       (setf (stream-peek-index stream) peek-buffer-length))
		      eofp))))))

(defmacro read-char-macro (stream eof-errorp eof-value method buffer)
  `(let ((index (stream-peek-index ,stream)))
     (cond
      ((= index peek-buffer-length)
       (let ((*current-peek-buffer* ,buffer)
	     (*current-peek-index* index))
	 (prog1 (funcall ,method ,stream ,eof-errorp ,eof-value)
		(setf (stream-peek-index ,stream) *current-peek-index*))))
      (t
       (setf (stream-peek-index ,stream) (1+ index))
       (aref (the simple-array ,buffer) index)))))

(defun read-char (&optional (stream *standard-input*) (eof-errorp t) eof-value
			    recursive-p)
  "Inputs a character from Stream and returns it."
  (declare (ignore recursive-p))
  (let ((stream (in-synonym-of stream)))
    (read-char-macro stream eof-errorp eof-value (stream-in stream)
		     (stream-peek-buffer stream))))

(defun unread-char (character &optional (stream *standard-input*))
  "Puts the Character back on the front of the input Stream."
  (let* ((stream (in-synonym-of stream))
	 (index (1- (stream-peek-index stream))))
    (setf (aref (the simple-array (stream-peek-buffer stream)) index) character
	  (stream-peek-index stream) index))
  nil)

(defun peek-char (&optional (peek-type nil) (stream *standard-input*)
			    (eof-errorp t) eof-value recursive-p)
  "Peeks at the next character in the input Stream.  See manual for details."
  (declare (ignore recursive-p))
  (let* ((stream (in-synonym-of stream))
	 (buffer (stream-peek-buffer stream))
	 (in-fun (stream-in stream))
	 (char (read-char-macro stream eof-errorp eof-value in-fun buffer)))
    (cond ((eq char eof-value) char)
	  ((characterp peek-type)
	   (do ((char char
		      (read-char-macro stream eof-errorp eof-value in-fun
				       buffer)))
	       ((or (eq char eof-value) (char= char peek-type))
		(unless (eq char eof-value)
		  (setf (schar buffer (decf (stream-peek-index stream))) char))
		char)))
	  ((eq peek-type t)
	   (do ((char char 
		      (read-char-macro stream eof-errorp eof-value in-fun
				       buffer)))
	       ((or (eq char eof-value) (not (whitespace-char-p char)))
		(unless (eq char eof-value)
		  (setf (schar buffer (decf (stream-peek-index stream))) char))
		char)))
	  (t
	   (setf (schar buffer (decf (stream-peek-index stream))) char)
	   char))))

(defun listen (&optional (stream *standard-input*))
  "Returns T if a character is availible on the given Stream."
  (let ((stream (in-synonym-of stream)))
    (or (/= (stream-peek-index stream) peek-buffer-length)
	(funcall (stream-listen stream) stream))))

(defun read-char-no-hang (&optional (stream *standard-input*)
				    (eof-errorp t) eof-value recursive-p)
  "Returns the next character from the Stream if one is availible, or nil."
  (declare (ignore recursive-p))
  (let* ((stream (in-synonym-of stream))
	 (index (stream-peek-index stream)))
    (cond
     ((= index peek-buffer-length)
      (if (funcall (stream-listen stream) stream)
	  (let ((*current-peek-buffer* (stream-peek-buffer stream))
		(*current-peek-index* index))
	    (prog1 (funcall (stream-in stream) stream eof-errorp eof-value)
		   (setf (stream-peek-index stream) *current-peek-index*)))))
     (t
      (setf (stream-peek-index stream) (1+ index))
      (schar (stream-peek-buffer stream) index)))))

(defun clear-input (&optional (stream *standard-input*))
  "Clears any buffered input associated with the Stream."
  (let ((stream (in-synonym-of stream)))
    (setf (stream-peek-index stream) peek-buffer-length)
    (funcall (stream-misc stream) stream :clear-input nil)))

(defun read-byte (stream &optional (eof-errorp t) eof-value)
  "Returns the next byte of the Stream."
  (with-in-stream stream stream-bin eof-errorp eof-value))

(defun read-n-bytes (stream buffer start numbytes &optional (eof-errorp t))
  "Reads Numbytes bytes into the Buffer starting at Start, and returns
  the number of bytes actually read if the end of file was hit before Numbytes
  bytes were read (and Eof-Errorp is false)."
  (with-in-stream stream stream-n-bin buffer start numbytes eof-errorp))

;;; Output functions:

(defun write-char (character &optional (stream *standard-output*))
  "Outputs the Character to the Stream."
  (with-out-stream stream stream-out character)
  character)

(defun terpri (&optional (stream *standard-output*))
  "Outputs a new line to the Stream."
  (with-out-stream stream stream-out #\newline)
  nil)

(defun fresh-line (&optional (stream *standard-output*))
  "Outputs a new line to the Stream if it is not positioned at the begining of
   a line.  Returns T if it output a new line, nil otherwise."
  (let ((stream (out-synonym-of stream)))
    (when (/= (or (charpos stream) 1) 0)
      (funcall (stream-out stream) stream #\newline)
      t)))

(defun write-string (string &optional (stream *standard-output*)
			    (start 0) (end (length (the vector string))))
  "Outputs the String to the given Stream."
  (if (slisp-array-p string)
      (let ((disp (%primitive header-ref string %array-displacement-slot))
	    (data (%primitive header-ref string %array-data-slot)))
	(with-out-stream stream stream-sout data (+ start disp) (+ end disp)))
      (with-out-stream stream stream-sout string start end))
  string)

(defun write-line (string &optional (stream *standard-output*)
			  (start 0) (end (length string)))
  "Outputs the String to the given Stream, followed by a newline character."
  (let ((stream (out-synonym-of stream)))
    (if (slisp-array-p string)
      (let ((disp (%primitive header-ref string %array-displacement-slot))
	    (data (%primitive header-ref string %array-data-slot)))
	(with-out-stream stream stream-sout data (+ start disp) (+ end disp)))
      (with-out-stream stream stream-sout string start end))
    (funcall (stream-out stream) stream #\newline))
  string)

(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."
  (with-out-stream stream stream-charpos))

(defun line-length (&optional (stream *standard-output*))
  "Returns the number of characters that will fit on a line of output on the
  given Stream, or Nil if that information is not available."
  (with-out-stream stream stream-misc :line-length nil))

(defun finish-output (&optional (stream *standard-output*))
  "Attempts to ensure that all output sent to the the Stream has reached its
   destination, and only then returns."
  (with-out-stream stream stream-misc :finish-output nil)
  nil)

(defun force-output (&optional (stream *standard-output*))
  "Attempts to force any buffered output to be sent."
  (with-out-stream stream stream-misc :force-output nil)
  nil)

(defun clear-output (&optional (stream *standard-output*))
  "Clears the given output Stream."
  (with-out-stream stream stream-misc :clear-output nil)
  nil)

(defun write-byte (integer stream)
  "Outputs the Integer to the binary Stream."
  (with-out-stream stream stream-bout integer)
  integer)