Many cleanups post JSON RPC

src/gerbil/prelude/core.ss

@@ -90,9 +90,9 @@ package: gerbil
     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/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/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/net/httpd/handler.ss

@@ -11,10 +11,10 @@
         :std/foreign
         :std/text/utf8
         :std/pregexp
-        :std/misc/with-id
         ./base
         (for-syntax :std/stxutil
                     :std/misc/string))
+
 (export http-request-handler
         http-request?
         http-request-method http-request-url http-request-path http-request-params

src/std/stxutil.ss

@@ -2,9 +2,7 @@
 ;;; © vyzo
 ;;; syntax utilities; import for-syntax
 (import <expander-runtime>
-        :gerbil/gambit/bytes
-        :std/format
-        :std/text/hex)
+        :std/format)
 (export #t (for-syntax #t))
 
 ;; format an identifier; see also stx-identifier
@@ -15,24 +13,11 @@
   (datum->syntax ctx (string->symbol (apply format fmt (map stx-e args)))
                  (stx-source ctx)))
 
-;; Use maybe-intern-symbol instead of string->symbol to avoid DoS attacks
-;; that cause you to intern too many symbols and run out of memory.
-;; : (Or Symbol String) <- String
-(def (maybe-intern-symbol string)
-  (or (##find-interned-symbol string) string))
-
-;; Use maybe-intern-symbol instead of string->keyword to avoid DoS attacks
-;; that cause you to intern too many keywords and run out of memory.
-;; : (Or Keyword String) <- String
-(def (maybe-intern-keyword string)
-  (or (##find-interned-keyword string) string))
-
 (def (displayify x port)
   (cond
    ((member x '(#f #t () #!void #!eof)) (void))
    ((or (string? x) (symbol? x) (number? x)) (display x port))
    ((keyword? x) (display (keyword->string x) port))
-   ((bytes? x) (display (bytes->string x) port))
    ((pair? x) (displayify (car x) port) (displayify (cdr x) port))
    ((vector? x) (displayify (vector->list x) port))
    ((AST? x) (displayify (stx-e x) port))
@@ -42,8 +27,22 @@
                        (x (string->symbol (stringify x)))))
 (def keywordify (case-lambda ((x) (if (keyword? x) x (string->keyword (stringify x))))
                        (x (string->keyword (stringify x)))))
+(def (identifierify stx . x) (datum->syntax stx (apply symbolify x)))
+
+
+;; Use maybe-intern-symbol instead of string->symbol to avoid DoS attacks
+;; that cause you to intern too many symbols and run out of memory.
+;; : (Or Symbol String) <- String
+(def (maybe-intern-symbol string)
+  (or (##find-interned-symbol string) string))
+
+;; Use maybe-intern-symbol instead of string->keyword to avoid DoS attacks
+;; that cause you to intern too many keywords and run out of memory.
+;; : (Or Keyword String) <- String
+(def (maybe-intern-keyword string)
+  (or (##find-interned-keyword string) string))
+
 (def maybe-symbolify (case-lambda ((x) (if (symbol? x) x (maybe-intern-symbol (stringify x))))
                              (x (maybe-intern-symbol (stringify x)))))
 (def maybe-keywordify (case-lambda ((x) (if (keyword? x) x (maybe-intern-keyword (stringify x))))
                               (x (maybe-intern-keyword (stringify x)))))
-(def (identifierify stx . x) (datum->syntax stx (apply symbolify x)))

src/std/sugar-test.ss

@@ -1,6 +1,7 @@
 (export sugar-test)
 
 (import :std/test
+        :std/misc/number
         :std/pregexp
         :std/sugar)
 
@@ -59,4 +60,29 @@
     (check ((is 'a test: eq?) 'a)       => #t)
     (check ((is 2.0) 2.0)               => #t)
     (check ((is "a") "a")               => #t))
-   ))
+
+    (test-case "with-id, defining variables"
+      (def mem (make-vector 5 0))
+      (defrule (defvar name n)
+        (with-id name ((@ #'name "@") (get #'name) (set #'name "-set!"))
+          (begin (def @ n) (def (get) (vector-ref mem @)) (def (set x) (vector-set! mem @ x)))))
+      (defvar A 0)
+      (defvar B 1)
+      (defvar C 2)
+      (defvar D 3)
+      (A-set! 42) (B-set! (+ (A) 27)) (increment! (C) 5) (D-set! (post-increment! (C) 18))
+      (check-equal? mem #(42 69 23 5 0)))
+    (test-case "with-id, variable resolution in macro"
+      (check-exception
+       (eval '(begin
+                (defsyntax (m stx)
+                  (def myvar "bar")
+                  #'(with-id ctx ((foo my-var)) (def foo 2)))
+                (m)))
+       true)
+      (defsyntax (m stx)
+        (with-syntax ((ctx (stx-car stx))
+                      (myvar "bar"))
+          #'(with-id ctx ((foo #'myvar)) (def foo 3))))
+      (m)
+      (check-equal? bar 3))))