(module input-port-with-location mzscheme
  (provide (all-defined))
  
  ;; Provides input ports with location information.  Meant to mimic
  ;; some of what mzscheme's port-next-location and count-port-lines!
  ;; does in a platform-independent way to make it easier for Dorai to
  ;; port.
  
  ;; ::open-input-file: path -> input-port/with-location
  (define (::open-input-file path)
    (let ((port (open-input-file path))
          (line 1)
          (col 0)
          (pos 1)
          (last-char #\newline)
          (closed? #f)
          (TAB-WIDTH 8))
      (letrec
          ((::read-char
            (lambda ()
              (::check-not-closed! 'read-char)
              (let ((next-char (read-char port)))
                (::update-location! next-char)
                (set! last-char next-char)
                next-char)))

           (::peek-char
            (lambda ()
              (::check-not-closed! 'peek-char)
              (peek-char port)))

           (::closed?
            (lambda ()
              closed?))

           (::get-path
            (lambda ()
              path))
           
           (::close-input-port
            (lambda ()
              (close-input-port port)
              (set! closed? #t)))

           (::port-next-location
            (lambda ()
              (::check-not-closed! 'port-next-location)
              (values line col pos)))

           (::check-not-closed!
            (lambda (symbol)
              (if closed?
                  (error symbol "input port is closed")
                  'ok)))
           
           (::update-location!
            (lambda (next-char)
              (cond
               ((eof-object? next-char)
                'do-nothing)
               ((char=? next-char #\tab)
                (set! col (* TAB-WIDTH
                             (quotient (+ col TAB-WIDTH) TAB-WIDTH)))
                (set! pos (+ pos 1)))
               ((char=? next-char #\return)
                (set! line (+ line 1))
                (set! col 0)
                (set! pos (+ pos 1)))
               ((and (char=? last-char #\return)
                     (char=? next-char #\newline))
                'do-nothing)
               ((char=? next-char #\newline)
                (set! line (+ line 1))
                (set! col 0)
                (set! pos (+ pos 1)))
               (else
                (set! col (+ col 1))
                (set! pos (+ pos 1)))))))

        (lambda (dispatch)
          (case dispatch
            ((read-char) ::read-char)
            ((peek-char) ::peek-char)
            ((closed?) ::closed?)
            ((get-path) ::get-path)
            ((close-input-port) ::close-input-port)
            ((port-next-location) ::port-next-location)
            (else
             (error 'input-port-with-location-dispatch
                    "Unknown operation: ~s" dispatch)))))))
  
  ;; read-char: input-port/with-location -> (union char eof-object)
  (define (::read-char port)
    ((port 'read-char)))
  
  ;; peek-char: input-port/with-location -> (union char eof-object)
  (define (::peek-char port)
    ((port 'peek-char)))

  ;; closed?: input-port/with-location -> boolean
  (define (::closed? port)
    ((port 'closed?)))

  (define (::get-path port)
    ((port 'get-path)))
  
  ;; close-input-port: input-port/with-location -> void
  (define (::close-input-port port)
    ((port 'close-input-port)))

  ;; port-next-location: input-port/with->location -> (values number
  ;; number number)
  ;; Returns the line number, column, and position.
  (define (::port-next-location port)
    ((port 'port-next-location))))