;;; Streams with arbitrary lookahead and line/column counting
;;; David Bindel, Sep 2005

(defstruct lstream
  (line   0)     ;; Cursor line number
  (eof    nil)   ;; Cursor EOF flag
  (stream nil)   ;; Stream
  (buf    nil))  ;; Lookahead buffer of (char line col) triples

(defun open-lstream (fname)
  "Open a new stream with char lookahead"
  (make-lstream :stream (open fname :direction :input)))

(defun close-lstream (ls)
  "Close a stream with char lookahead"
  (close (lstream-stream ls)))

(defun read-line-lstream (ls)
  "Read a line's worth of characters"
  (let ((s    (read-line (lstream-stream ls) nil '*eof*))
        (line (incf (lstream-line ls)))
        (col  0))
    (if (eq s '*eof*)
        (setf (lstream-eof ls) t)
        (setf (lstream-buf ls)
              (nconc (lstream-buf ls)
                     (mapcar #'(lambda (x) `(,x ,line ,(incf col)))
                             (coerce s 'list))
                     `((#\newline ,line ,(incf col))))))))

(defun refill-lstream (ls n)
  "Fill lstream until EOF or until n chars are buffered"
  (until (or (nth (1- n) (lstream-buf ls))
             (lstream-eof ls))
    (read-line-lstream ls)))

(defun peek-lstream (ls &optional (n 1))
  "Peek n characters ahead; returns char, line, col"
  (refill-lstream ls n)
  (values-list (or (nth (1- n) (lstream-buf ls))
                   `(nil ,(lstream-line ls) 1))))

(defun peek-lstream-line (ls &optional (n 1))
  "Peek n characters ahead; return line"
  (multiple-value-bind (c line col)
      (peek-lstream ls n)
    line))

(defun peek-lstream-col (ls &optional (n 1))
  "Peek n characters ahead; return line"
  (multiple-value-bind (c line col)
      (peek-lstream ls n)
    col))

(defun skip-lstream (ls &optional (n 1))
  "Skip over n characters in the stream (assume they're already buffered)"
  (dotimes (i n) 
    (pop (lstream-buf ls))))

(defun read-lstream (ls)
  "Read a character."
  (refill-lstream ls 1)
  (values-list (pop (lstream-buf ls))))


;; Macro to iterate over an lstream.  Continues until eof or until test
;; is false.  The variables this-{c,line,col} are bound to the current
;; character, line, and column number; similarly with next-{c,line,col}

(defmacro while-lstream (ls test &rest body)
  `(loop
    (multiple-value-bind (this-c this-line this-col)
        (peek-lstream ,ls)
      (multiple-value-bind (next-c next-line next-col)
          (peek-lstream ,ls 2)
        (if (and this-c ,test)
            (progn
              (read-lstream ls)
              ,@body)
            (return))))))


;; Test code: Read a file and break it into tokens based on white space
;; and line breaks.

(defun test-lstream-tokenizer (fname)
  (let ((ls (open-lstream fname)))
    (while-lstream ls (member this-c '(#\space #\tab #\newline)))
    (while (peek-lstream ls)
      (let ((line (peek-lstream-line ls))
            (col  (peek-lstream-col  ls))
            (tok nil))
        (while-lstream ls (not (member this-c '(#\space #\tab #\newline)))
                       (push this-c tok))
        (format t "~A ~A: ~A~%" 
                line col (coerce (nreverse tok) 'string)))
      (while-lstream ls (member this-c '(#\space #\tab #\newline))))))