;;; FILE: input-streams.scm
;;; PROGRAMMER: Mayer Goldberg
;;; PURPOSE: This file implements a flexible input streams package for
;;; Scheme 
;;;
;;; LAST UPDATED: 12/24/1998

(define ^input-stream
  (lambda (get unget)
    (lambda (user)
      (user get unget))))

;;; the definitions for various input streams

(define string->char-input-stream
  (lambda (string)
    (let ((length (string-length string))
	  (position 0)
	  (unget-buffer '()))
      (letrec ((get
		(lambda (return-object return-if-not-available)
		  (cond ((pair? unget-buffer)
			 (let ((ch (car unget-buffer)))
			   (set! unget-buffer (cdr unget-buffer))
			   (return-object ch)))
			((< position length)
			 (let ((ch (string-ref string position)))
			   (set! position (add1 position))
			   (return-object ch)))
			(else (return-if-not-available)))))
	       (unget
		(lambda (ch)
		  (set! unget-buffer (cons ch unget-buffer)))))
	(^input-stream get unget)))))

(define file->char-input-stream
  (lambda (file-name)
    (let ((input-port (open-input-file file-name))
	  (unget-buffer '()))
      (letrec ((get-if-port-closed
		(lambda (return-object return-if-not-available)
		  (if (null? unget-buffer)
		      (return-if-not-available)
		      (let ((ch (car unget-buffer)))
			(set! unget-buffer (cdr unget-buffer))
			(return-object ch)))))
	       (get
		(letrec ((get
			  (lambda (return-object return-if-not-available)
			    (if (null? unget-buffer)
				(let ((ch (read-char input-port)))
				  (if (eof-object? ch)
				      (begin
					(close-input-port input-port)
					(set! get get-if-port-closed)
					(return-if-not-available))
				      (return-object ch)))
				(let ((ch (car unget-buffer)))
				  (set! unget-buffer (cdr unget-buffer))
				  (return-object ch))))))
		  (lambda (return-object return-if-not-available)
		    (get return-object return-if-not-available))))
	       (unget
		(lambda (ch)
		  (set! unget-buffer (cons ch unget-buffer)))))
	(^input-stream get unget)))))

(define sexpr->char-input-stream
  (lambda (x)
    (string->char-input-stream
     (format "~s" x))))

(define console->char-input-stream
  (lambda ()
    (let ((input-port (current-input-port)))
      (input-port->char-input-stream input-port))))

(define input-port->char-input-stream
  (lambda (input-port)
    (let ((unget-buffer '()))
      (letrec ((get
		(lambda (return-object return-if-not-available)
		  (if (null? unget-buffer)
		      (let ((ch (read-char input-port)))
			(if (eof-object? ch)
			    (return-if-not-available)
			    (return-object ch)))
		      (let ((ch (car unget-buffer)))
			(set! unget-buffer (cdr unget-buffer))
			(return-object ch)))))
	       (unget
		(lambda (ch)
		  (set! unget-buffer (cons ch unget-buffer)))))
	(^input-stream get unget)))))