;;;; Copyright 2002, Jonathan Bachrach.  See file TERMS.

(use goo/boot)
(use goo/fun)
(use goo/class)
(use goo/macros)
(use goo/any)
(use goo/log)
(use goo/chr)
(use goo/mag)
(use goo/math)
(use goo/types)
(use goo/cols/col)
(use goo/cols/colx)
(use goo/cols/seq)
(use goo/cols/seqx)
(use goo/cols/vec)
(use goo/io/%port.c)

(dl %current-out-port)
(dl %current-in-port)
(dl %open-in-file)
(dl %open-out-file )
(dl %close-out-port)
(dl %close-in-port)
(dl %put)
(dl %puts)
(dl %force-out)
(dl %ready?)
(dl %get)
(dl %newline)
(dl %peek)
(dl %ready)

(exported
 (dc <port> (<any>))
 
 (dg open ((t (t< <port>)) name|<str> => <port>))
 (dg close (x|<port>))
 with-port
 (dc <in-port> (<port>))
 (dp! port-line (<in-port> => <int>) 1)
 (dg get (port|<in-port> => <chr>))
 (dg gets (port|<in-port>) => <str>)
 (dg peek (port|<in-port> => <chr>))
 (dg ready? (port|<in-port> => <log>))

 (dc <out-port> (<port>))
 (dg newline (port|<out-port>))
 (dg force-out (port|<out-port>))
 (dg put (port|<out-port> c|<chr>))
 (dg puts (port|<out-port> s|<str>))
 
 (dc <file-port> (<port>))

 (dp port-filename (<file-port> => <str>) "")
 (dp port-handle (<file-port> => <any>))
 )

(dm close (port|<port>) #f)

(exported
 (dc <file-in-port> (<file-port> <in-port>))
 (dc <file-out-port> (<file-port> <out-port>))
 
 (dv in #f)
 (dv out #f)

 (dc <str-port> (<port>)))

(dp! port-guts (<str-port> => <seq>) "")

(exported
 (dg port-contents (port|<str-port> => <str>))
 (dc <str-in-port> (<str-port> <in-port>))
 (dp! port-index (<str-in-port> => <int>) 0)
 (dc <str-out-port> (<str-port> <out-port>))
 port-to-str)

(dm gets (port|<in-port> => <str>)
  (rep loop ((res '()) (c (get port)))
    (if (or (eof-object? c) (== c #\newline))
        (as <str> (rev! res))
        (loop (pair c res) (get port)))))

(dm open (t|(t= <file-in-port>) filename|<str> => <file-in-port>)
  (new <file-in-port> 
    port-filename filename
    port-handle   (%open-in-file (%su filename))))

(dm open (t|(t= <file-out-port>) filename|<str> => <file-out-port>)
  (new <file-out-port> 
    port-filename filename
    port-handle   (%open-out-file (%su filename))))

(dm close (port|<file-in-port>)
  (%close-in-port (port-handle port)))

(dm close (port|<file-out-port>)
  (%close-out-port (port-handle port)))

(ds with-port ((,name ,port) ,@body)
  `(let ((,name #f))
     (fin (seq (set ,name ,port) ,@body)
          (and ,name (close ,name)))))

(dv in (new <file-in-port> 
         port-filename "in"
         port-handle   (%current-in-port)))

(dv out (new <file-out-port>
          port-filename "out"
          port-handle   (%current-out-port)))

(dm get (port|<file-in-port> => <chr>)
  (def c (%cb (%get (port-handle port))))
  (when (== c #\newline) (incf (port-line port)))
  c)

(dm peek (port|<file-in-port> => <chr>)
  (%cb (%peek (port-handle port))))

(dm ready? (port|<file-in-port> => <log>)
  (%bb (%ready? (port-handle port))))

(dm newline (port|<out-port>) 
  (put port #\newline))

(dm force-out (port|<file-out-port>)
  (%force-out (port-handle port)))

(dm put (port|<file-out-port> c|<chr>)
  (%put (port-handle port) (%cu c)))

(dm puts (port|<file-out-port> s|<str>)
  (%puts (port-handle port) (%su s)))

;;; STR-PORT IMPLEMENTATION

(dm port-contents (port|<str-port> => <str>)
  (as <str> (port-guts port)))

(dm open ((t (t= <str-in-port>)) dat|<str> => <str-in-port>)
  (new <str-in-port> port-guts dat))

;; VERY INEFFICIENT

(dm open ((t (t= <str-out-port>)) dat|<str> => <str-out-port>)
  (new <str-out-port> port-guts (as <vec> dat)))

;; TODO: EOF OBJECT MUST BE A CHR

(dm peek (port|<str-in-port> => <chr>)
  (if (>= (port-index port) (len (port-guts port)))
      (eof-object)
      (elt (port-guts port) (port-index port))))

(dm get (port|<str-in-port> => <chr>)
  (if (>= (port-index port) (len (port-guts port)))
      (eof-object)
      (let ((res (elt (port-guts port) (port-index port))))
        (incf (port-index port))
        res)))

(dm ready? (port|<str-in-port> => <log>)
  #t)

(dm put (port|<str-out-port> c|<chr>)
  (set (port-guts port) (add! (port-guts port) c)))

(dm puts (port|<str-out-port> s|<str>)
  (set (port-guts port) (cat! (port-guts port) s)))

(ds port-to-str (,name ,@body)
  `(let ((,name (open <str-out-port> "")))
     ,@body (port-contents ,name)))
