;;; -*- 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 is a file that goes along With Stream.Slisp.  It contains
;;; stuff that is needed at compile time elsewhere.
;;;
;;; The stream structure:

(defconstant peek-buffer-length 100 "The size of a stream peek-buffer.")
(defstruct (stream (:predicate streamp) (:conc-name stream-)
		   (:print-function %print-stream))
  (peek-buffer (make-string peek-buffer-length)); Character look ahead buffer
  (peek-index peek-buffer-length)		; Index into peek-buffer
  (readline #'ill-in)				; ReadLine function
  (in #'ill-in)					; Inch function
  (bin #'ill-bin)				; Byte input function
  (n-bin #'ill-bin)				; N-Byte input function
  (listen #'ill-in)				; Listen function
  (out #'ill-out)				; Ouch function
  (bout #'ill-bout)				; Byte output function
  (sout #'ill-out)				; String output function
  (charpos #'do-nothing)			; Charpos function
  (misc #'do-nothing))				; Less used methods

(defvar *current-peek-buffer* ()
  "The value of this variable is the peek buffer to be used by cooperative
  stream in methods.")
(defvar *current-peek-index* ()
  "The value of this variable is the peek index to be used by cooperative
  stream in methods.")

;;;; Standard streams:
;;;
;;; The initialization of these streams is performed by Stream-Init,
;;; which lives in the file of machine-specific stream functions.
;;;
(defvar *terminal-io* () "Terminal I/O stream.")
(defvar *standard-input* () "Default input stream.")
(defvar *standard-output* () "Default output stream.")
(defvar *error-output* () "Error output stream.")
(defvar *query-io* () "Query I/O stream.")
(defvar *trace-output* () "Trace output stream.")

(defun ill-in (stream &rest ignore)
  (declare (ignore ignore))
  (error "~S is not a character input stream." stream))
(defun ill-out (stream &rest ignore)
  (declare (ignore ignore))
  (error "~S is not a character output stream." stream))
(defun ill-bin (stream &rest ignore)
  (declare (ignore ignore))
  (error "~S is not a binary input stream." stream))
(defun ill-bout (stream &rest ignore)
  (declare (ignore ignore))
  (error "~S is not a binary output stream." stream))
(defun closed-flame (stream &rest ignore)
  (declare (ignore ignore))
  (error "~S is closed." stream))
(defun do-nothing (&rest ignore)
  (declare (ignore ignore)))

(defun %print-stream (structure stream d)
  (declare (ignore d structure))
  (write-string "#<Bare Stream>" stream))

;;; HOW THE STREAM STRUCTURE IS USED:
;;;
;;;    Many of the slots of the stream structure contain functions
;;; which are called to perform some operation on the stream.  Closed
;;; streams have #'Closed-Flame in all of their function slots.  If
;;; one side of an I/O or echo stream is closed, the whole stream is
;;; considered closed.  The functions in the operation slots take
;;; arguments as follows:
;;;
;;; Readline:		Stream, Eof-Errorp, Eof-Value
;;; In:			Stream, Eof-Errorp, Eof-Value
;;; Bin:		Stream, Eof-Errorp, Eof-Value
;;; N-Bin:		Stream, Buffer, Start, Numbytes, Eof-Errorp
;;; Listen:		Stream
;;; Out:		Stream, Character
;;; Bout:		Stream, Integer
;;; Sout:		Stream, String, Start, End
;;; Charpos:		Stream
;;; Misc:		Stream, Operation, Abortflag
;;;
;;;    In order to save space, some of the less common stream operations
;;; are handled by just one function, the Misc method.  This function
;;; is passed a keyword which indicates the operation to perform.
;;; The following keywords are used:
;;;  :close - Do any stream specific stuff to close the stream.  The methods
;;;    are set to closed-flame by the close function, so that need not be
;;;    done by this function.
;;;  :clear-input - Clear any unread input
;;;  :finish-output, :force-output - Cause output to happen
;;;  :clear-output - Clear any undone output
;;;  :element-type - Return the type of element the stream deals with
;;;
;;;    In order to do almost anything useful, it is necessary to
;;; define a new type of structure that includes stream, so that the
;;; stream can have some state information.
;;;
;;; THE STREAM PEEK-BUFFER:
;;;
;;;    The peek-buffer in the stream holds characters that are ready
;;; to be read by some text input function.  If there are any
;;; characters in it then they are used by the reading function before
;;; any method is called.  Characters can get in it in two ways:
;;;  1] They are put there by unread-char.
;;;  2] They are put there by a read method.
;;;
;;;    The first case is uninteresting except in that it means that
;;; any method that does the second must leave room for a character in
;;; the peek-buffer so that this can be done.  The second reason is
;;; the justification for all this hair.  An in-method which does this
;;; is said to "Cooperate".
;;;
;;;    A Cooperative in-method blt's a bunch of soon-to-be-read
;;; characters into the peek buffer in addition to returning the
;;; current character.  If this is done then the number of times that
;;; the in method is called is reduced by one or two orders of
;;; magnitude, resulting in a significant speedup in text input.
;;; 
;;;    The peek-buffer slot is a string peek-buffer-length long, this
;;; contains the characters in the peek buffer.  The peek-index is the
;;; index in the peek-buffer of the first available character.  The
;;; available characters are thus between peek-index and the length of
;;; the peek-buffer.
;;;
;;;    When an in-method accesses the peek-buffer and peek-index it
;;; must do it via the *current-peek-buffer* and *current-peek-index*
;;; specials.  This is so that stream indirection works correctly.
;;; The peek-buffer to be manipulated must be the one in the top level
;;; stream.  If the method just used the peek buffer in the final
;;; stream, then Read-Char would never notice the characters.

;;; Eof-Or-Lose is a useful macro that handles EOF.

(defmacro eof-or-lose (stream eof-errorp eof-value)
  `(if ,eof-errorp
       (error "~S: Stream hit EOF unexpectedly." ,stream)
       ,eof-value))

;;; These macros handle the special cases of t and nil for input and
;;; output streams.
;;;
(defmacro in-synonym-of (stream)
  `(cond ((eq ,stream t) *terminal-io*)
	 (,stream)
	 (t *standard-input*)))

(defmacro out-synonym-of (stream)
  `(cond ((eq ,stream t) *terminal-io*)
	 (,stream)
	 (t *standard-output*)))

;;; With-Mumble-Stream calls the function in the given Slot of the Stream with
;;; the Args.
;;;
(defmacro with-in-stream (stream slot &rest args)
  `(let ((stream (in-synonym-of ,stream)))
     (funcall (,slot stream) stream ,@args)))

(defmacro with-out-stream (stream slot &rest args)
  `(let ((stream (out-synonym-of ,stream)))
     (funcall (,slot stream) stream ,@args)))

;;;; These are hacks to make the reader win.

;;; Prepare-For-Fast-Read-Char  --  Internal
;;;
;;;    This macro sets up some local vars for use by the Fast-Read-Char
;;; macro within the enclosed lexical scope.
;;;
(defmacro prepare-for-fast-read-char (stream &body forms)
  `(let* ((%frc-stream% (in-synonym-of ,stream))
	  (%frc-method% (stream-in %frc-stream%))
	  (%frc-buffer% (stream-peek-buffer %frc-stream%))
	  (*current-peek-buffer* %frc-buffer%)
	  (%frc-index% (stream-peek-index %frc-stream%))
	  *current-peek-index*)
     (declare (simple-array %frc-buffer%) (fixnum %frc-index%)
	      (special *current-peek-buffer* *current-peek-index*))
     ,@forms))

;;; Done-With-Fast-Read-Char  --  Internal
;;;
;;;    This macro must be called after one is done with fast-read-char
;;; inside it's scope to decache the stream-peek-index.
;;;
(defmacro done-with-fast-read-char ()
  `(setf (stream-peek-index %frc-stream%) %frc-index%))

;;; Fast-Read-Char  --  Internal
;;;
;;;    This macro can be used instead of Read-Char within the scope of
;;; a Prepare-For-Fast-Read-Char.
;;;
(defmacro fast-read-char (&optional (eof-errorp t) (eof-value ()))
  `(cond
    ((= %frc-index% peek-buffer-length)
     (setf (stream-peek-index %frc-stream%) %frc-index%)
     (setq *current-peek-index* peek-buffer-length)
     (prog1 (funcall %frc-method% %frc-stream% ,eof-errorp ,eof-value)
	    (setq %frc-index% *current-peek-index*)))
    (t
     (prog1 (aref %frc-buffer% %frc-index%)
	    (incf %frc-index%)))))