Many cleanups post JSON RPC

src/gerbil/prelude/core.ss

@@ -85,14 +85,14 @@ package: gerbil
     eval interaction-environment scheme-report-environment
     ;; 6.6 i/o
     call-with-input-file call-with-output-file
-    input-port? output-port?
+    input-port? output-port? port?
     current-input-port current-output-port
     with-input-from-file with-output-to-file
     open-input-file open-output-file
     close-input-port close-output-port
-    read read-char peek-char
+    read read-char peek-char read-u8 peek-u8
     eof-object? char-ready?
-    write display newline write-char
+    write display newline write-char write-u8
     load
     ;; transcript-on transcript-off ; void
     ))

src/std/build-spec.ss

@@ -42,6 +42,7 @@
     "io/file"
     "io/util"
     "io/error"
+    "io/port"
     "io/bio/types"
     "io/bio/input"
     "io/bio/delimited"
@@ -167,6 +168,8 @@
     "parser/grammar"
     "parser"
     ;; :std/text
+    "text/char-set"
+    "text/basic-parsers"
     "text/utf8"
     "text/utf16"
     "text/utf32"
@@ -309,7 +312,6 @@
     "crypto"
     ;; :std/misc
     "misc/atom"
-    "misc/with-id"
     "misc/concurrent-plan"
     "misc/timeout"
     "misc/list-builder"

src/std/io/api.ss

@@ -7,11 +7,13 @@
         ./delimited
         ./file
         ./util
-        ./error)
+        ./error
+        ./port)
 (export (import: ./bio/api)
         (import: ./strio/api)
         (import: ./socket/api)
         (import: ./delimited)
         (import: ./file)
         (import: ./util)
-        (import: ./error))
+        (import: ./error)
+        (import: ./port))

src/std/io/bio/api.ss

@@ -4,6 +4,7 @@
 (import :std/interface
         ../interface
         ../dummy
+        ../port
         ./types
         ./input
         ./delimited
@@ -30,30 +31,38 @@
    (else
     (error "Bad argument; expected fixnum or u8vector" buffer-or-size))))
 
-(def (open-buffered-reader reader-or-u8vector (buffer-or-size default-buffer-size))
+(def (open-buffered-reader pre-reader (buffer-or-size default-buffer-size))
   (cond
-   ((u8vector? reader-or-u8vector)
+   ((BufferedReader? pre-reader) pre-reader)
+   ((is-BufferedReader? pre-reader) (BufferedReader pre-reader))
+   ((u8vector? pre-reader)
     (BufferedReader
-     (make-input-buffer dummy-reader reader-or-u8vector 0 (u8vector-length reader-or-u8vector) #f)))
-   ((is-Reader? reader-or-u8vector)
+     (make-input-buffer dummy-reader pre-reader 0 (u8vector-length pre-reader) #f)))
+   ((is-Reader? pre-reader)
     (let ((buffer (make-u8vector-buffer buffer-or-size))
-          (reader (Reader reader-or-u8vector)))
+          (reader (Reader pre-reader)))
       (BufferedReader (make-input-buffer reader buffer 0 0 #f))))
+   ((input-port? pre-reader)
+    (BufferedReader (raw-port pre-reader))) ;; TODO: use a cooked-port instead
    (else
-    (error "Bad argument; expected reader instance or u8vector" reader-or-u8vector))))
+    (error "Bad argument; expected reader instance or u8vector" pre-reader))))
 
-(def (open-buffered-writer maybe-writer (buffer-or-size default-buffer-size))
+(def (open-buffered-writer pre-writer (buffer-or-size default-buffer-size))
   (cond
-   ((not maybe-writer)
+   ((BufferedWriter? pre-writer) pre-writer)
+   ((is-BufferedWriter? pre-writer) (BufferedWriter pre-writer))
+   ((not pre-writer)
     (let ((writer (open-chunk-writer))
           (buffer (make-u8vector-buffer buffer-or-size)))
       (BufferedWriter (make-output-buffer writer buffer 0 #f))))
-   ((is-Writer? maybe-writer)
-    (let ((writer (Writer maybe-writer))
+   ((is-Writer? pre-writer)
+    (let ((writer (Writer pre-writer))
           (buffer (make-u8vector-buffer buffer-or-size)))
       (BufferedWriter (make-output-buffer writer buffer 0 #f))))
+   ((output-port? pre-writer)
+    (BufferedWriter (raw-port pre-writer))) ;; TODO: use a cooked-port instead
    (else
-    (error "Bad argument; expected reader instance or #f" maybe-writer))))
+    (error "Bad argument; expected reader instance or #f" pre-writer))))
 
 (def (open-chunk-writer)
   (Writer (make-chunked-output-buffer [] #f)))

src/std/io/interface.ss

@@ -27,12 +27,13 @@
   (write u8v (start 0) (end (u8vector-length u8v))))
 
 ;; buffered IO
-(interface (BufferedReader Reader)
+(interface (PeekableReader Reader)
   ;; reads a single byte
   (read-u8)
   ;; peeks the next byte
-  (peek-u8)
+  (peek-u8))
 
+(interface (BufferedReader PeekableReader)
   ;; puts back some bytes previously read; can also inject bytes.
   ;; - previous-input is a u8 or a list of u8s injected back into the buffer
   (put-back previous-input)
@@ -51,7 +52,7 @@
   ;; writes a single byte
   (write-u8 u8)
 
-  ;; flushes the buffer to the underlyin output instance
+  ;; flushes the buffer to the underlying output instance
   (flush)
 
   ;; resets the underlying output and buffer state, allowing reuse of buffers.
@@ -62,17 +63,18 @@
   ;; read into a string
   (read-string str (start 0) (end (string-length str)) (need 0)))
 
-(interface (BufferedStringReader StringReader)
+(interface (PeekableStringReader StringReader)
   ;; reads a single char
   (read-char)
   ;; peeks the next char
-  (peek-char)
+  (peek-char))
 
+(interface (BufferedStringReader PeekableStringReader)
   ;; puts back some chars previously read; can also inject characters.
   ;; - previous-input is a char or a list of chars injected into the buffer
   (put-back previous-input)
 
-    ;; skips the next count bytes of input
+  ;; skips the next count chars of input
   (skip count)
 
   ;; returns a new StringBufferedReader instance delimiting the input length that shares

src/std/io/port.ss

@@ -0,0 +1,45 @@
+(import
+  :gerbil/gambit/ports
+  :std/sugar)
+
+(export raw-port raw-port-port)
+
+;; Raw wrapper for a port without any buffering
+(defstruct raw-port (port) final: #t unchecked: #t)
+
+(defrule (def-raw-port-method (name port . args) body ...)
+  (defmethod {name raw-port}
+    (lambda (self . args)
+      (let (port (&raw-port-port self))
+        body ...))))
+
+(def-raw-port-method (close port)
+  (close-port port))
+(def-raw-port-method (read-char port)
+  (read-char port))
+(def-raw-port-method (peek-char port)
+  (peek-char port))
+(def-raw-port-method (read port u8v (start 0) (end (u8vector-length u8v)) (need 0))
+  (read-subu8vector u8v port start end need))
+(def-raw-port-method (write port u8v (start 0) (end (u8vector-length u8v)))
+  (write-subu8vector u8v port start end))
+(def-raw-port-method (read-u8 port)
+  (read-u8 port))
+(def-raw-port-method (peek-u8 port)
+  (peek-u8 port))
+(def-raw-port-method (put-back port previous-input)
+  (error "cannot put-back into port" port previous-input))
+(def-raw-port-method (skip port count)
+  (error "cannot skip from port" port count))
+(def-raw-port-method (delimit port limit)
+  (error "cannot delimit port" port limit))
+(def-raw-port-method (reset! port reader)
+  (error "cannot reset! port" port reader))
+(def-raw-port-method (write-u8 port u8)
+  (write-u8 u8 port))
+(def-raw-port-method (flush port)
+  (force-output port))
+(def-raw-port-method (read-string port str (start 0) (end (string-length str)) (need 0))
+  (read-substring str start end port need))
+(def-raw-port-method (write-string port str (start 0) (end (string-length str)))
+  (write-substring str start end port))

src/std/io/strio/api.ss

@@ -4,6 +4,7 @@
 (import :std/interface
         ../interface
         ../dummy
+        ../port
         ../bio/types
         ./types
         ./input
@@ -71,11 +72,13 @@
     (else
      (error "Unsupported character encoding" codec))))
 
-(def (open-string-reader reader (buffer-or-size default-u8vector-buffer-size)
+(def (open-string-reader pre-reader (buffer-or-size default-u8vector-buffer-size)
                          encoding: (codec 'UTF-8))
   (cond
-   ((is-BufferedReader? reader)
-    (let (obj (interface-instance-object reader))
+   ((StringReader? pre-reader) pre-reader)
+   ((is-StringReader? pre-reader) (StringReader pre-reader))
+   ((is-BufferedReader? pre-reader)
+    (let (obj (interface-instance-object pre-reader))
       (StringReader
        (if (input-buffer? obj)
          ;; already an input-buffer, use it directly to avoid double-buffering
@@ -86,21 +89,25 @@
                                                 0 0 #f)
                              (character-decoder codec)
                              #f)))))
-   ((is-Reader? reader)
+   ((is-Reader? pre-reader)
     (StringReader
-     (make-string-reader (make-input-buffer (Reader reader)
+     (make-string-reader (make-input-buffer (Reader pre-reader)
                                             (make-u8vector-buffer buffer-or-size)
                                             0 0 #f)
                          (character-decoder codec)
                          #f)))
+   ((input-port? pre-reader)
+    (StringReader (raw-port pre-reader))) ;; TODO: use a cooked-port instead
    (else
-    (error "Bad reader; expected implementation of Reader" reader))))
+    (error "Bad reader; expected implementation of Reader" pre-reader))))
 
-(def (open-string-writer writer (buffer-or-size default-u8vector-buffer-size)
+(def (open-string-writer pre-writer (buffer-or-size default-u8vector-buffer-size)
                          encoding: (codec 'UTF-8))
   (cond
-   ((is-BufferedWriter? writer)
-    (let (obj (interface-instance-object writer))
+   ((StringWriter? pre-writer) pre-writer)
+   ((is-StringWriter? pre-writer) (StringWriter pre-writer))
+   ((is-BufferedWriter? pre-writer)
+    (let (obj (interface-instance-object pre-writer))
       (StringWriter
        (if (output-buffer? obj)
          ;; already an output-buffer
@@ -111,59 +118,69 @@
                                                  0 #f)
                              (character-encoder codec)
                              #f)))))
-   ((is-Writer? writer)
+   ((is-Writer? pre-writer)
     (StringWriter
-     (make-string-writer (make-output-buffer (Writer writer)
+     (make-string-writer (make-output-buffer (Writer pre-writer)
                                              (make-u8vector-buffer buffer-or-size)
                                              0 #f)
                          (character-encoder codec)
                          #f)))
+   ((output-port? pre-writer)
+    (StringWriter (raw-port pre-writer))) ;; TODO: use a cooked-port instead
    (else
-    (error "Bad writer; expected implementation of Writer" writer))))
+    (error "Bad writer; expected implementation of Writer" pre-writer))))
 
-(def (open-buffered-string-reader reader-or-string (buffer-or-size default-string-buffer-size)
+(def (open-buffered-string-reader pre-reader (buffer-or-size default-string-buffer-size)
                                   encoding: (codec 'UTF-8))
   (cond
-   ((string? reader-or-string)
+   ((string? pre-reader)
     (BufferedStringReader
      (make-string-input-buffer dummy-string-reader
-                               reader-or-string 0 (string-length reader-or-string)
+                               pre-reader 0 (string-length pre-reader)
                                #f)))
-   ((is-StringReader? reader-or-string)
+   ((BufferedStringReader? pre-reader) pre-reader)
+   ((is-BufferedStringReader? pre-reader) (BufferedStringReader pre-reader))
+   ((is-StringReader? pre-reader)
     (BufferedStringReader
-     (make-string-input-buffer (StringReader reader-or-string)
+     (make-string-input-buffer (StringReader pre-reader)
                                (make-string-buffer buffer-or-size) 0 0
                                #f)))
-   ((is-Reader? reader-or-string)
+   ((is-Reader? pre-reader)
     (BufferedStringReader
-     (make-string-input-buffer (open-string-reader reader-or-string (double buffer-or-size)
+     (make-string-input-buffer (open-string-reader pre-reader (double buffer-or-size)
                                                    encoding: codec)
                                (make-string-buffer buffer-or-size) 0 0
                                #f)))
+   ((input-port? pre-reader)
+    (BufferedStringReader (raw-port pre-reader))) ;; TODO: use a cooked-port instead
    (else
-    (error "Bad reader; expected string or implementation of StringReader or Reader" reader-or-string))))
+    (error "Bad reader; expected string or implementation of StringReader or Reader" pre-reader))))
 
-(def (open-buffered-string-writer maybe-writer (buffer-or-size default-string-buffer-size)
+(def (open-buffered-string-writer pre-writer (buffer-or-size default-string-buffer-size)
                                   encoding: (codec 'UTF-8))
   (cond
-   ((not maybe-writer)
+   ((not pre-writer)
     (BufferedStringWriter
      (make-string-output-buffer (open-chunk-writer)
                                 (make-string-buffer buffer-or-size)
                                 0 #f)))
-   ((is-StringWriter? maybe-writer)
+   ((BufferedStringWriter? pre-writer) pre-writer)
+   ((is-BufferedStringWriter? pre-writer) (BufferedStringWriter pre-writer))
+   ((is-StringWriter? pre-writer)
     (BufferedStringWriter
-     (make-string-output-buffer (StringWriter maybe-writer)
+     (make-string-output-buffer (StringWriter pre-writer)
                                 (make-string-buffer buffer-or-size)
                                 0 #f)))
-   ((is-Writer? maybe-writer)
+   ((is-Writer? pre-writer)
     (BufferedStringWriter
-     (make-string-output-buffer (open-string-writer maybe-writer (double buffer-or-size)
+     (make-string-output-buffer (open-string-writer pre-writer (double buffer-or-size)
                                                     encoding: codec)
                                 (make-string-buffer buffer-or-size)
                                 0 #f)))
+   ((output-port? pre-writer)
+    (BufferedStringWriter (raw-port pre-writer))) ;; TODO: use a cooked-port instead
    (else
-    (error "Bad writer; expected #f or implementation of StringWriter or writer" maybe-writer))))
+    (error "Bad writer; expected #f or implementation of StringWriter or writer" pre-writer))))
 
 (def (open-chunk-writer)
   (StringWriter (make-chunked-string-output-buffer [] #f)))

src/std/misc/bytes.ss

@@ -110,6 +110,8 @@
   &u8vector-double-set!/native
 
   &u8vector-swap!
+
+  u8vector-every
   )
 
 ;;; Endianness
@@ -695,3 +697,8 @@ END-C
   (define-c-lambda &u8vector-double-set!/native (scheme-object int double) void
     "*(double*)(U8_DATA(___arg1) + ___arg2) = ___arg3; ___return;")
   )
+
+(def (u8vector-every pred bytes)
+  (declare (fixnum))
+  (let lp ((i (1- (u8vector-length bytes))))
+    (or (< i 0) (and (pred (u8vector-ref bytes i)) (lp (1- i))))))

src/std/misc/ports.ss

@@ -23,7 +23,8 @@
         call-with-output
         with-output
         call-with-input
-        with-input)
+        with-input
+        char-port-eof?)
 
 ;; _gambit#.scm
 (extern namespace: #f
@@ -348,3 +349,5 @@
 (defrules with-input ()
   ((_ (i x) body ...) (call-with-input x (lambda (i) body ...)))
   ((_ (i) body ...) (call-with-input i (lambda (i) body ...))))
+
+(def (char-port-eof? in) (macro-character-port-peek-eof? in))