#lang scheme

;; TODO:
;;  add parse-expect?
;;  Rename "create-scanner" as "string->scanner";
;;  Provide "scanner->string"

(require (lib "pregexp.ss")
         (lib "13.ss" "srfi")  ; strings
         (lib "14.ss" "srfi")  ; char-set
         )

(provide peek
         pop!
         input-ready?
         push!
         create-scanner
         )

(define DEFAULT_PUNCTUATION "()[]{}<>!@$%^&*~+=;:'\"?,#") ; N.B. '.' not punct, since it might occur in the middle of a number.
(define DEFAULT_WHITESPACE  "\n\t ")


(define-struct scanner (port buffer delimiters whitespace)
  #:mutable) 
            

;; create-scanner: string-> scanner  (reads from the given string)
;; create-scanner: -> scanner        (reads from stdin)
;; create-scanner: port -> scanner   (reads from the given port)
(define (create-scanner . args)
  (let* {[port (cond [(empty? args) (current-input-port)]
                     [(string? (first args)) (open-input-string (first args))]
                     [(input-port? (first args)) (first args)])]}
  (make-scanner port
                ""
                (string->char-set DEFAULT_PUNCTUATION)
                (string->char-set DEFAULT_WHITESPACE))))

                
(define (set-whitespace! s str)
  (set-scanner-whitespace! s (string->char-set str)))
(define (set-delimiters! s str)
  (set-scanner-delimiters! s (string->char-set str)))

  
  
  



;; Will 'pop!' or 'peek' block?
;; note that the buffer being eof counts
;; as non-blocking (since eof will be returned immediately).
;;
(define (input-ready? s)
  (or (eof-object? (scanner-buffer s))
      (not (string=? (scanner-buffer s) ""))))


(define (refresh-buffer s)
  (when (not (input-ready? s))
    (set-scanner-buffer! s (read-line (scanner-port s)))
    (unless (eof-object? (scanner-buffer s)) (skip-white! s))
    ; Check whether the entire line was whitespace:
    (refresh-buffer s)))

(define (peek/help s consume?)
  (refresh-buffer s)
  (if (eof-object? (scanner-buffer s))
      (scanner-buffer s)
      (let* {[position (string-index (scanner-buffer s) (char-set-union (scanner-delimiters s)
                                                                        (scanner-whitespace s)))]
             [stop-at (if (number? position)
                          (max position 1)
                          (string-length (scanner-buffer s)))]
             [token (substring (scanner-buffer s) 0 stop-at)]
             }
        (when consume?
          (set-scanner-buffer! s (substring (scanner-buffer s) 
                                            stop-at 
                                            (string-length (scanner-buffer s))))
          (skip-white! s))
        (or (string->number token) token))))
    
(define (pop! s)
  (peek/help s true))
(define (peek s)
  (peek/help s false))

;;; BUGGY -- doesn't handle pushing onto EOF, or when " " isn't white.
(define (push! s item)
  (set-scanner-buffer! s (string-append (format "~a" item) " " (scanner-buffer s))))

  
(define (skip-white! s)
  (set-scanner-buffer! s (string-trim (scanner-buffer s) (scanner-whitespace s))))