substrate-lang 0.9.3 → 0.10.0

package/std/browser/devtools.sub

@@ -27,11 +27,12 @@
 (define socket-head event-head)
 
 (define (relay)
-  (let ([why string])
+  (let ([why error] [id u32 0])
     (event-handler! worker-source from-parent)
     (set! (-> socket-head handle) from-socket)
-    (set! socket (websocket-connect (@ (host-args) 0) 0 (cast (ptr void) (& socket-head)) (& why)))
-    (when (== socket 0) (host-exit 1 why))))
+    (unless (websocket-connect (@ (host-args) 0) 0 (cast (ptr void) (& socket-head)) (& id) (& why))
+      (host-exit 1 (error-text (& why))))
+    (set! socket id)))
 
 (define (from-parent [source u32] [kind u32] [id u32] [tag (ptr void)] [value i32])
   (when (and (== kind worker-message) (== id 0))
@@ -55,7 +56,7 @@
 ;; ---- the connection ----
 
 (define (devtools-connect [d (ptr devtools)] [address string] [handler (fn ((ptr devtools) string (ptr json-value) string))]
-                          [state (ptr void)] [err (ptr string)]) -> bool
+                          [state (ptr void)] [err (ptr error)]) -> bool
   (let ([text string] [deadline (+ (clock-monotonic) patience)])
     (set! (-> d head handle) relay-heard)
     (set! (-> d next) 0)
@@ -65,11 +66,13 @@
     (set! (-> d awaited) (make-buffer))
     (set! (-> d kept) (make-buffer))
     (set! (-> d why) "")
-    (set! (-> d relay) (worker-start relay (cast (slice u8) address) 0 (cast (ptr void) (& (-> d head))) err))
-    (when (== (-> d relay) 0) (return #f))
+    (unless (worker-start relay (cast (slice u8) address) 0 (cast (ptr void) (& (-> d head))) (& (-> d relay)) err)
+      (return #f))
     (while #t
       (unless (next! d deadline (& text))
-        (set! (@ err) (if (> (-> d why length) 0) (-> d why) "Chromium did not take a DevTools connection within 30 s"))
+        (if (> (-> d why length) 0)
+            (error-fail! err error-other (-> d why))
+            (error-fail! err error-timeout "Chromium did not take a DevTools connection within 30 s"))
         (devtools-close d)
         (return #f))
       (let ([open (== text "open")])
@@ -137,49 +140,51 @@
     (-> d next)))
 
 (define (devtools-call [d (ptr devtools)] [a (ptr arena)] [method string] [parameters string] [session string]
-                       [result (ptr (ptr json-value))] [err (ptr string)]) -> bool
+                       [result (ptr (ptr json-value))] [err (ptr error)]) -> bool
   (let ([id (devtools-send d method parameters session)] [deadline (+ (clock-monotonic) patience)] [text string]
         [ok #f] [done #f])
     (buffer-add-u32! (& (-> d awaited)) id)
     (while (not done)
       (cond [(or (taken! d id (& text)) (next! d deadline (& text)))
-             (let ([e (make-arena)] [je json-error] [m (ptr json-value) 0] [rid i64 0])
-               (set! m (json-parse (& e) text (& je)))
+             (let ([e (make-arena)] [m (ptr json-value) 0] [rid i64 0])
+               (json-parse (& e) text (& m) 0)
                (free (-> text bytes))
                (cond [(== m 0) (begin)]
                      [(json-as-i64 (json-get m "id") (& rid))
                       (cond [(== (cast u32 rid) id)
                              (set! done #t)
-                             (let ([error (json-get m "error")] [r (json-get m "result")] [why string])
-                               (if (== error 0)
+                             (let ([refusal (json-get m "error")] [r (json-get m "result")] [why string])
+                               (if (== refusal 0)
                                    (begin
                                      (set! (@ result) (if (== r 0) 0 (json-copy a r)))
                                      (set! ok #t))
-                                   (let ([b (make-buffer)] [message (json-get error "message")])
+                                   (let ([b (make-buffer)] [message (json-get refusal "message")])
                                      (json-as-string message (& why))
                                      (buffer-add-string! (& b) method)
                                      (buffer-add-string! (& b) ": ")
                                      (buffer-add-string! (& b) why)
-                                     (set! (@ err) (buffer-string (& b))))))]
+                                     (error-fail! err error-other (buffer-string (& b)))
+                                     (buffer-free! (& b)))))]
                             [(awaited? d (cast u32 rid)) (kept! d (cast u32 rid) m)]
                             [else (begin)])]
                      [else (heard! d m)])
                (arena-free (& e)))]
             [else
              (set! done #t)
-             (let ([b (make-buffer)])
+             (let ([b (make-buffer)] [late (== (-> d why length) 0)])
                (buffer-add-string! (& b) method)
                (buffer-add-string! (& b) ": ")
-               (buffer-add-string! (& b) (if (> (-> d why length) 0) (-> d why) "Chromium did not answer within 30 s"))
-               (set! (@ err) (buffer-string (& b))))]))
+               (buffer-add-string! (& b) (if late "Chromium did not answer within 30 s" (-> d why)))
+               (error-fail! err (if late error-timeout error-other) (buffer-string (& b)))
+               (buffer-free! (& b)))]))
     (-= (-> d awaited length) 4)
     ok))
 
 (define (devtools-pump [d (ptr devtools)] [ms f64])
   (let ([deadline (+ (clock-monotonic) ms)] [text string])
     (while (next! d deadline (& text))
-      (let ([e (make-arena)] [je json-error] [m (ptr json-value) 0] [rid i64 0])
-        (set! m (json-parse (& e) text (& je)))
+      (let ([e (make-arena)] [m (ptr json-value) 0] [rid i64 0])
+        (json-parse (& e) text (& m) 0)
         (free (-> text bytes))
         (cond [(== m 0) (begin)]
               [(json-as-i64 (json-get m "id") (& rid)) (when (awaited? d (cast u32 rid)) (kept! d (cast u32 rid) m))]

package/std/compress/deflate.sub

@@ -3,12 +3,10 @@
 ;; whichever is shortest. deflate! adds in's compressed form to out: deflate-none may hold some back, deflate-sync sends
 ;; everything and ends at a whole byte, deflate-finish ends the stream. deflater-reset! starts another stream, and
 ;; deflate-alone! compresses bytes as if nothing came before, ending as a sync, so one deflater serves many streams.
-(provide deflater deflater-init! deflater-free! deflater-reset! deflate! deflate-alone! deflate-none deflate-sync
-         deflate-finish)
+(provide deflater deflater-init! deflater-free! deflater-reset! deflate! deflate-alone! deflate-flush deflate-none
+         deflate-sync deflate-finish)
 
-(const deflate-none i32 0)
-(const deflate-sync i32 1)
-(const deflate-finish i32 2)
+(enum deflate-flush deflate-none deflate-sync deflate-finish)
 
 (const wsize u32 32768)
 (const wmask u32 32767)
@@ -155,10 +153,10 @@
     (set! (-> d lazy) (@ settings (+ (* l 4) 1)))
     (set! (-> d nice) (@ settings (+ (* l 4) 2)))
     (set! (-> d chain) (@ settings (+ (* l 4) 3))))
-  (set! (-> d window) (cast (ptr u8) (malloc (+ (* 2 wsize) 272))))
-  (set! (-> d head) (cast (ptr u16) (calloc hash-size 2)))
-  (set! (-> d prev) (cast (ptr u16) (calloc wsize 2)))
-  (set! (-> d syms) (cast (ptr u32) (malloc (* (+ most-symbols 1) 4))))
+  (set! (-> d window) (malloc (+ (* 2 wsize) 272)))
+  (set! (-> d head) (-> (new 0 u16 hash-size) items))
+  (set! (-> d prev) (-> (new 0 u16 wsize) items))
+  (set! (-> d syms) (malloc (* (+ most-symbols 1) (sizeof u32))))
   (set! (-> d strstart) 1)
   (deflater-reset! d))
 
@@ -432,7 +430,7 @@
 ;; ---- matching ----
 
 ;; greedy! takes a match wherever it finds one, and returns #t when it waits for more of the stream.
-(define (greedy! [d (ptr deflater)] [out (ptr buffer)] [in (slice u8)] [at (ptr u32)] [flush i32]) -> bool
+(define (greedy! [d (ptr deflater)] [out (ptr buffer)] [in (slice u8)] [at (ptr u32)] [flush deflate-flush]) -> bool
   (while #t
     (when (< (-> d lookahead) min-lookahead)
       (fill! d in at)
@@ -459,7 +457,7 @@
   #f)
 
 ;; lazy! takes a match only when the next position has none longer.
-(define (lazy! [d (ptr deflater)] [out (ptr buffer)] [in (slice u8)] [at (ptr u32)] [flush i32]) -> bool
+(define (lazy! [d (ptr deflater)] [out (ptr buffer)] [in (slice u8)] [at (ptr u32)] [flush deflate-flush]) -> bool
   (while #t
     (when (< (-> d lookahead) min-lookahead)
       (fill! d in at)
@@ -497,7 +495,7 @@
     (set! (-> d available) #f))
   #f)
 
-(define (deflate! [d (ptr deflater)] [out (ptr buffer)] [in (slice u8)] [flush i32])
+(define (deflate! [d (ptr deflater)] [out (ptr buffer)] [in (slice u8)] [flush deflate-flush])
   (let ([at u32 0])
     (when (if (>= (-> d level) 4) (lazy! d out in (& at) flush) (greedy! d out in (& at) flush)) (return))
     (cond [(== flush deflate-finish)

package/std/compress/gzip.sub

@@ -1,9 +1,9 @@
 ;; The gzip format (RFC 1952) around DEFLATE data, and its CRC-32. gunzip! decodes whole gzip data, each member in
-;; turn, adding at most most bytes to out, and returns 0 or a negative code whose message gzip-message gives.
+;; turn, adding at most most bytes to out.
 (require-unqualified "inflate.sub")
 (require-unqualified "deflate.sub")
 
-(provide crc32 gunzip! gzip-message gzip-start! gzip-end! gzip!)
+(provide crc32 gunzip! gzip-start! gzip-end! gzip!)
 
 ;; CRC-32 with eight tables, slicing eight bytes at a time.
 (define tables (array u32 2048))
@@ -82,7 +82,9 @@
     [(-105) "incorrect data check"]
     [(-106) "incorrect length check"]
     [(-107) "unexpected end of data"]
-    [else (inflate-message code)]))
+    [else "no error"]))
+
+(define (refused [err (ptr error)] [code i32]) -> bool (error-fail! err error-invalid (gzip-message code)))
 
 (define (le32 [p (ptr u8)]) -> u32
   (bit-or (cast u32 (@ p 0)) (<< (cast u32 (@ p 1)) 8) (<< (cast u32 (@ p 2)) 16) (<< (cast u32 (@ p 3)) 24)))
@@ -114,19 +116,19 @@
       (+= i 2))
     (cast i32 i)))
 
-(define (gunzip! [out (ptr buffer)] [in (slice u8)] [most u32]) -> i32
+(define (gunzip! [out (ptr buffer)] [in (slice u8)] [most u32] [err (ptr error)]) -> bool
   (let ([at u32 0] [start (-> out length)])
     (while #t
       (let* ([rest (slice in at)] [h (header-length rest)] [used u32 0] [begun (-> out length)])
-        (when (< h 0) (return h))
-        (let ([result (inflate! out (slice rest (cast u32 h)) (- most (- begun start)) (& used))])
-          (unless (== result 0) (return result))
-          (let ([trailer (+ (cast u32 h) used)])
-            (when (< (- (-> rest length) trailer) 4) (return short-header))
-            (unless (== (le32 (+ (-> rest items) trailer)) (crc32 0 (slice (buffer-bytes out) begun)))
-              (return bad-data-check))
-            (when (< (- (-> rest length) trailer) 8) (return short-header))
-            (unless (== (le32 (+ (-> rest items) trailer 4)) (- (-> out length) begun)) (return bad-length-check))
-            (+= at (+ trailer 8))
-            (when (== at (-> in length)) (return 0))))))
-    0))
+        (when (< h 0) (return (refused err h)))
+        (unless (inflate! out (slice rest (cast u32 h)) (- most (- begun start)) (& used) err) (return #f))
+        (let ([trailer (+ (cast u32 h) used)])
+          (when (< (- (-> rest length) trailer) 4) (return (refused err short-header)))
+          (unless (== (le32 (+ (-> rest items) trailer)) (crc32 0 (slice (buffer-bytes out) begun)))
+            (return (refused err bad-data-check)))
+          (when (< (- (-> rest length) trailer) 8) (return (refused err short-header)))
+          (unless (== (le32 (+ (-> rest items) trailer 4)) (- (-> out length) begun))
+            (return (refused err bad-length-check)))
+          (+= at (+ trailer 8))
+          (when (== at (-> in length)) (return #t)))))
+    #t))

package/std/compress/inflate.sub

@@ -1,7 +1,6 @@
 ;; DEFLATE decoding (RFC 1951) of whole buffers, with lookup tables as zlib and libdeflate decode. inflate! decodes the
-;; data at the start of in, adding at most most bytes to out, sets used to the bytes it took, and returns 0 or a negative
-;; code whose message, zlib's, inflate-message gives.
-(provide inflate! inflate-message)
+;; data at the start of in, adding at most most bytes to out, and sets used to the bytes it took.
+(provide inflate!)
 
 ;; Table entries hold a code's length in bits, an op and a value. Op 0 is a literal, 16 plus a count of extra bits a
 ;; base length or distance, 32 the end of a block, 64 plus a width a link to the table of that many bits at the value,
@@ -279,7 +278,11 @@
                        (+= (-> out length) n)))))])))
     0))
 
-(define (inflate! [out (ptr buffer)] [in (slice u8)] [most u32] [used (ptr u32)]) -> i32
+(define (inflate! [out (ptr buffer)] [in (slice u8)] [most u32] [used (ptr u32)] [err (ptr error)]) -> bool
+  (let ([code (inflate-code! out in most used)])
+    (or (== code 0) (error-fail! err (if (== code too-large) error-other error-invalid) (inflate-message code)))))
+
+(define (inflate-code! [out (ptr buffer)] [in (slice u8)] [most u32] [used (ptr u32)]) -> i32
   (let ([r reader] [last #f] [result i32 0])
     (unless fixed (fixed!))
     (set! (-> r bits) 0)

package/std/crypto/password.sub

@@ -62,10 +62,10 @@
   (set! last j)
   (when (== first j)
     (when (== running 0)
-      (let ([why string])
+      (let ([why error] [id u32 0])
         (set! (-> listener handle) answered)
-        (set! running (worker-start password-worker 0 0 (& listener) (& why)))
-        (when (== running 0) (host-trap why))))
+        (unless (worker-start password-worker 0 0 (& listener) (& id) (& why)) (host-trap (error-text (& why))))
+        (set! running id)))
     (send-first!)))
 
 (define (unpadded! [b (ptr buffer)] [bytes (slice u8)])

package/std/doc/doc.sub

@@ -45,7 +45,7 @@
     id))
 
 (define (text-of [id datum]) -> string
-  (let ([b (slice u8)] [why string]) (if (< (fs-read-file (datum->string (host-file id)) (& b) (& why)) 0) "" (cast string b))))
+  (let ([b (slice u8)]) (if (fs-read-file (datum->string (host-file id)) (& b) 0) (cast string b) "")))
 
 (define (forms-of [text string] [id datum]) -> datum (program-forms (read-all text (string->symbol (datum->string id)))))
 
@@ -103,7 +103,7 @@
 (define (described [id datum]) -> datum
   (let ([known (assoc id descriptions)] [info fs-info] [forms datum 0] [d datum 0] [spec datum 0] [next datum 0])
     (unless (== known 0) (return (cdr known)))
-    (when (and (== (fs-stat (datum->string (host-file id)) (& info) 0) 0) (== (-> info kind) fs-file))
+    (when (and (fs-stat (datum->string (host-file id)) (& info) 0) (== (-> info kind) fs-file))
       (set! forms (forms-of (text-of id) id))
       (set! d (doc-forms-of forms))
       (set! spec (language-of forms))

package/std/encoding/json.sub

@@ -8,7 +8,7 @@
          json-parse json-write! json-get json-at json-count json-as-i64 json-as-f64 json-as-string json-as-bool
          json-push! json-add! json-insert! json-replace! json-replace-at! json-remove! json-remove-at! json-copy
          json-equal? json-reader json-reader-start! json-reader-free! json-next! json-skip!
-         json-token-error json-token-end json-token-start-array json-token-end-array json-token-start-object
+         json-token json-token-error json-token-end json-token-start-array json-token-end-array json-token-start-object
          json-token-end-object json-token-key json-token-string json-token-number json-token-true json-token-false
          json-token-null)
 
@@ -22,40 +22,24 @@
 
 (struct json-member [key string] [value json-value])
 
-(struct json-error [message string] [offset u32] [line u32] [column u32])
+(struct json-error [error error] [offset u32] [line u32] [column u32])
 
 ;; ---- the token reader ----
 
-(const json-token-error u32 0)
-(const json-token-end u32 1)
-(const json-token-start-array u32 2)
-(const json-token-end-array u32 3)
-(const json-token-start-object u32 4)
-(const json-token-end-object u32 5)
-(const json-token-key u32 6)
-(const json-token-string u32 7)
-(const json-token-number u32 8)
-(const json-token-true u32 9)
-(const json-token-false u32 10)
-(const json-token-null u32 11)
+(enum json-token
+  json-token-error json-token-end json-token-start-array json-token-end-array json-token-start-object
+  json-token-end-object json-token-key json-token-string json-token-number json-token-true json-token-false
+  json-token-null)
 
 ;; What may come next, after Go's tokenState.
-(const top-value u32 0)
-(const top-end u32 1)
-(const array-start u32 2)
-(const array-value u32 3)
-(const array-comma u32 4)
-(const object-start u32 5)
-(const object-key u32 6)
-(const object-colon u32 7)
-(const object-value u32 8)
-(const object-comma u32 9)
-(const failed u32 10)
+(enum token-state
+  top-value top-end array-start array-value array-comma object-start object-key object-colon object-value object-comma
+  failed)
 
 (const depth-limit u32 1000)
 
-(struct json-reader [text string] [at u32] [state u32] [depth u32] [kinds (array u8 1000)] [token string] [number f64]
-        [scratch buffer] [error json-error])
+(struct json-reader [text string] [at u32] [state token-state] [depth u32] [kinds (array u8 1000)] [token string]
+        [number f64] [scratch buffer] [error json-error])
 
 (define (json-reader-start! [r (ptr json-reader)] [text string])
   (set! (-> r text) text)
@@ -65,14 +49,17 @@
   (set! (-> r token) "")
   (set! (-> r number) 0.0)
   (set! (-> r scratch) (make-buffer))
-  (set! (-> r error message) "")
+  (set! (-> r error error code) 0)
+  (set! (-> r error error message) (make-buffer))
   (set! (-> r error offset) 0)
   (set! (-> r error line) 0)
   (set! (-> r error column) 0))
 
-(define (json-reader-free! [r (ptr json-reader)]) (buffer-free! (& (-> r scratch))))
+(define (json-reader-free! [r (ptr json-reader)])
+  (buffer-free! (& (-> r scratch)))
+  (error-free! (& (-> r error error))))
 
-(define (json-next! [r (ptr json-reader)]) -> u32
+(define (json-next! [r (ptr json-reader)]) -> json-token
   (let ([s (-> r state)] [c (space! r)])
     (cond [(or (== s array-value) (== s object-value))
            (cond [(== c #\,)
@@ -121,7 +108,7 @@
     (set! (-> r at) i)
     256))
 
-(define (value! [r (ptr json-reader)] [c u32]) -> u32
+(define (value! [r (ptr json-reader)] [c u32]) -> json-token
   (cond [(== c #\")
          (+= (-> r at) 1)
          (if (string! r) (after-value! r json-token-string) json-token-error)]
@@ -134,7 +121,7 @@
         [(== c 256) (if (== (-> r depth) 0) (fail! r "the text has no value") (ended! r))]
         [else (fail! r "expected a value")]))
 
-(define (word! [r (ptr json-reader)] [w string] [t u32]) -> u32
+(define (word! [r (ptr json-reader)] [w string] [t json-token]) -> json-token
   (let ([end (+ (-> r at) (-> w length))])
     (if (and (<= end (-> r text length)) (== (memcmp (+ (-> r text bytes) (-> r at)) (-> w bytes) (-> w length)) 0))
         (begin
@@ -142,13 +129,13 @@
           (after-value! r t))
         (fail! r "expected a value"))))
 
-(define (after-value! [r (ptr json-reader)] [t u32]) -> u32
+(define (after-value! [r (ptr json-reader)] [t json-token]) -> json-token
   (set! (-> r state) (cond [(== (-> r depth) 0) top-end]
                            [(== (@ (-> r kinds) (- (-> r depth) 1)) 1) array-value]
                            [else object-value]))
   t)
 
-(define (open! [r (ptr json-reader)] [kind u32] [t u32]) -> u32
+(define (open! [r (ptr json-reader)] [kind u32] [t json-token]) -> json-token
   (when (== (-> r depth) depth-limit) (return (fail! r "nested too deeply")))
   (set! (@ (-> r kinds) (-> r depth)) kind)
   (+= (-> r depth) 1)
@@ -156,20 +143,20 @@
   (set! (-> r state) (if (== kind 1) array-start object-start))
   t)
 
-(define (close! [r (ptr json-reader)]) -> u32
+(define (close! [r (ptr json-reader)]) -> json-token
   (-= (-> r depth) 1)
   (after-value! r (if (== (@ (-> r kinds) (-> r depth)) 1) json-token-end-array json-token-end-object)))
 
-(define (ended! [r (ptr json-reader)]) -> u32
+(define (ended! [r (ptr json-reader)]) -> json-token
   (fail! r (if (== (@ (-> r kinds) (- (-> r depth) 1)) 1) "the text ends inside an array" "the text ends inside an object")))
 
-(define (fail! [r (ptr json-reader)] [message string]) -> u32
+(define (fail! [r (ptr json-reader)] [message string]) -> json-token
   (let ([p (-> r text bytes)] [line u32 1] [from u32 0])
     (for ([i u32 0]) (< i (-> r at)) (+= i 1)
       (when (== (@ p i) 10)
         (+= line 1)
         (set! from (+ i 1))))
-    (set! (-> r error message) message)
+    (error-fail! (& (-> r error error)) error-invalid message)
     (set! (-> r error offset) (-> r at))
     (set! (-> r error line) line)
     (set! (-> r error column) (+ (- (-> r at) from) 1))
@@ -178,6 +165,14 @@
 
 (define (reject! [r (ptr json-reader)] [message string]) -> bool (fail! r message) #f)
 
+(define (failed-into! [r (ptr json-reader)] [err (ptr json-error)]) -> bool
+  (unless (== err 0)
+    (error-fail! (& (-> err error)) (-> r error error code) (error-text (& (-> r error error))))
+    (set! (-> err offset) (-> r error offset))
+    (set! (-> err line) (-> r error line))
+    (set! (-> err column) (-> r error column)))
+  #f)
+
 (define (string! [r (ptr json-reader)]) -> bool
   (let ([p (-> r text bytes)] [start (-> r at)] [i (-> r at)] [end (-> r text length)] [c u32 0] [k u32 0])
     (while (< i end)
@@ -320,14 +315,11 @@
 
 ;; ---- parsing ----
 
-(define (arena-text [a (ptr arena)] [s string]) -> string
-  (let* ([n (-> s length)] [q (cast (ptr u8) (arena-alloc a n))])
-    (memcpy q (-> s bytes) n)
-    (cast string (slice q n))))
+(define (arena-text [a (ptr arena)] [s string]) -> string (copy a s))
 
-(define (json-parse [a (ptr arena)] [text string] [err (ptr json-error)]) -> (ptr json-value)
+(define (json-parse [a (ptr arena)] [text string] [value (ptr (ptr json-value))] [err (ptr json-error)]) -> bool
   (let ([r json-reader] [values (make-buffer)] [members (make-buffer)] [starts (array u32 1000)]
-        [root (ptr json-value) 0] [t u32 0] [v json-value (json-null)] [k u32 0] [m json-member] [placed #f])
+        [root (ptr json-value) 0] [t json-token] [v json-value (json-null)] [k u32 0] [m json-member] [placed #f])
     (json-reader-start! (& r) text)
     (while #t
       (set! t (json-next! (& r)))
@@ -364,12 +356,12 @@
              (set! (-> members length) (* (@ starts (-> r depth)) (sizeof json-member)))]
             [(== t json-token-end) (break)]
             [else
-             (when (!= err 0) (set! (@ err) (-> r error)))
+             (failed-into! (& r) err)
              (set! root 0)
              (break)])
       (when placed
         (cond [(== (-> r depth) 0)
-               (set! root (cast (ptr json-value) (arena-alloc a (sizeof json-value))))
+               (set! root (new a json-value))
                (set! (@ root) v)]
               [(== (@ (-> r kinds) (- (-> r depth) 1)) 1)
                (buffer-add! (& values) (slice (cast (ptr u8) (& v)) (sizeof json-value)))]
@@ -379,13 +371,12 @@
     (json-reader-free! (& r))
     (buffer-free! (& values))
     (buffer-free! (& members))
-    root))
+    (set! (@ value) root)
+    (!= root 0)))
 
 ;; The k items of size bytes from index from of bytes, copied into a, or 0 for none.
 (define (block [a (ptr arena)] [bytes (ptr u8)] [from u32] [k u32] [size u32]) -> (ptr void)
-  (if (== k 0)
-      0
-      (memcpy (arena-alloc a (* k size)) (+ bytes (* from size)) (* k size))))
+  (if (== k 0) 0 (-> (copy a (slice (+ bytes (* from size)) (* k size))) items)))
 
 ;; ---- writing ----
 
@@ -597,7 +588,7 @@
        (when (> i count) (return #f))
        (when (== count room)
          (set! room (if (== room 0) 4 (* 2 room)))
-         (let ([q (cast (ptr json-value) (arena-alloc a (* room (sizeof json-value))))])
+         (let ([q (-> (new a json-value room) items)])
            (when (> count 0) (memcpy q p (* count (sizeof json-value))))
            (set! p q)))
        (memcpy (+ p i 1) (+ p i) (* (- count i) (sizeof json-value)))
@@ -613,7 +604,7 @@
      (let ([p (-> members items)] [count (-> members length)])
        (when (== count room)
          (set! room (if (== room 0) 4 (* 2 room)))
-         (let ([q (cast (ptr json-member) (arena-alloc a (* room (sizeof json-member))))])
+         (let ([q (-> (new a json-member room) items)])
            (when (> count 0) (memcpy q p (* count (sizeof json-member))))
            (set! p q)))
        (let ([m (+ p count)])
@@ -660,7 +651,7 @@
     [_ #f]))
 
 (define (json-copy [a (ptr arena)] [v (ptr json-value)]) -> (ptr json-value)
-  (let ([out (cast (ptr json-value) (arena-alloc a (sizeof json-value)))])
+  (let ([out (new a json-value)])
     (copy-into! a out v)
     out))
 
@@ -668,17 +659,17 @@
   (if (== v 0) (set! (@ out) (json-null)) (set! (@ out) (@ v)))
   (match out
     [(json-array items room)
-     (let* ([count (-> items length)] [p (cast (ptr json-value) (arena-alloc a (* count (sizeof json-value))))])
-       (for ([i u32 0]) (< i count) (+= i 1) (copy-into! a (+ p i) (& (@ items i))))
-       (set! items (slice p count))
+     (let* ([count (-> items length)] [p (new a json-value count)])
+       (for ([i u32 0]) (< i count) (+= i 1) (copy-into! a (& (@ p i)) (& (@ items i))))
+       (set! items p)
        (set! room count))]
     [(json-object members room)
-     (let* ([count (-> members length)] [p (cast (ptr json-member) (arena-alloc a (* count (sizeof json-member))))])
+     (let* ([count (-> members length)] [p (new a json-member count)])
        (for ([i u32 0]) (< i count) (+= i 1)
-         (let ([m (& (@ members i))] [q (+ p i)])
+         (let ([m (& (@ members i))] [q (& (@ p i))])
            (set! (-> q key) (arena-text a (-> m key)))
            (copy-into! a (& (-> q value)) (& (-> m value)))))
-       (set! members (slice p count))
+       (set! members p)
        (set! room count))]
     [_ (own! a out)]))
 
@@ -709,17 +700,17 @@
 
 ;; ---- reading into types ----
 
-(define (expect! [r (ptr json-reader)] [t u32] [want u32] [message string]) -> bool
+(define (expect! [r (ptr json-reader)] [t json-token] [want json-token] [message string]) -> bool
   (cond [(== t want) #t]
         [(== t json-token-error) #f]
         [else (reject! r message)]))
 
-(define (take-unsigned! [r (ptr json-reader)] [t u32] [most u64] [to (ptr u64)]) -> bool
+(define (take-unsigned! [r (ptr json-reader)] [t json-token] [most u64] [to (ptr u64)]) -> bool
   (and (expect! r t json-token-number "expected a number")
        (or (and (digits? (-> r token) 10) (digits-integer (-> r token) 10 #f to) (<= (@ to) most))
            (reject! r "expected an integer within the field's type"))))
 
-(define (take-signed! [r (ptr json-reader)] [t u32] [least i64] [most i64] [to (ptr i64)]) -> bool
+(define (take-signed! [r (ptr json-reader)] [t json-token] [least i64] [most i64] [to (ptr i64)]) -> bool
   (unless (expect! r t json-token-number "expected a number") (return #f))
   (let* ([negative (== (@ (-> r token) 0) #\-)] [digits (slice (-> r token) (if negative 1 0))] [k u64 0])
     (or (and (digits? digits 10) (digits-integer digits 10 negative (& k))
@@ -727,23 +718,23 @@
              (begin (set! (@ to) (cast i64 k)) #t))
         (reject! r "expected an integer within the field's type"))))
 
-(define (take-float! [r (ptr json-reader)] [t u32] [to (ptr f64)]) -> bool
+(define (take-float! [r (ptr json-reader)] [t json-token] [to (ptr f64)]) -> bool
   (and (expect! r t json-token-number "expected a number")
        (begin (set! (@ to) (-> r number)) #t)))
 
-(define (take-bool! [r (ptr json-reader)] [t u32] [to (ptr bool)]) -> bool
+(define (take-bool! [r (ptr json-reader)] [t json-token] [to (ptr bool)]) -> bool
   (cond [(== t json-token-true) (set! (@ to) #t) #t]
         [(== t json-token-false) (set! (@ to) #f) #t]
         [else (expect! r t json-token-true "expected true or false")]))
 
-(define (take-text! [r (ptr json-reader)] [a (ptr arena)] [t u32] [to (ptr string)]) -> bool
+(define (take-text! [r (ptr json-reader)] [a (ptr arena)] [t json-token] [to (ptr string)]) -> bool
   (and (expect! r t json-token-string "expected a string")
        (begin (set! (@ to) (arena-text a (-> r token))) #t)))
 
 (define (end-of-text! [r (ptr json-reader)]) -> bool (== (json-next! r) json-token-end))
 
 (define (finish! [r (ptr json-reader)] [ok bool] [err (ptr json-error)]) -> bool
-  (when (and (not ok) (!= err 0)) (set! (@ err) (-> r error)))
+  (unless ok (failed-into! r err))
   (json-reader-free! r)
   ok)
 
@@ -786,7 +777,7 @@
   (define (struct-code [t datum] [fields datum]) -> datum
     `(,#`(define (#,(derive-name t '"json-write!") [b (ptr buffer)] [v (ptr #,t)])
            #,@(object-write fields (for/list ([f fields]) #`(-> v #,(car f)))))
-      ,#`(define (#,(derive-name t '"json-read-from!") [r (ptr json-reader)] [a (ptr arena)] [token u32] [v (ptr #,t)]) -> bool
+      ,#`(define (#,(derive-name t '"json-read-from!") [r (ptr json-reader)] [a (ptr arena)] [token json-token] [v (ptr #,t)]) -> bool
            #,(object-read #`token fields (for/list ([f fields]) #`(-> v #,(car f))))
            #t)
       ,(entry t)))
@@ -812,7 +803,7 @@
                                     objects))))))
       `(,#`(define (#,(derive-name t '"json-write!") [b (ptr buffer)] [v (ptr #,t)])
              (match v #,@(reverse writes)))
-        ,#`(define (#,(derive-name t '"json-read-from!") [r (ptr json-reader)] [a (ptr arena)] [token u32] [v (ptr #,t)]) -> bool
+        ,#`(define (#,(derive-name t '"json-read-from!") [r (ptr json-reader)] [a (ptr arena)] [token json-token] [v (ptr #,t)]) -> bool
              (cond [(== token json-token-string)
                     (cond #,@(reverse names)
                           [else (return (reject! r "unknown case"))])]
@@ -861,7 +852,7 @@
                                      (return (reject! r #,(literal (format "missing field ~a" `(,(syntax-e (car f))))))))
                                  checks))))
         (+= i 1))
-      #`(let ([#,seen (array bool #,n)] [#,k u32 0])
+      #`(let ([#,seen (array bool #,n)] [#,k json-token])
           (memset #,seen 0 #,n)
           #,@(reverse defaults)
           (unless (expect! r #,token json-token-start-object "expected an object") (return #f))
@@ -918,20 +909,20 @@
            (let ([q (derive-fresh 'q)] [e (type-syntax (cadr type))])
              #`(if (== #,u json-token-null)
                    (set! #,p 0)
-                   (let ([#,q (cast (ptr #,e) (arena-alloc a (sizeof #,e)))])
+                   (let ([#,q (new a #,e)])
                      #,(read-code (cadr type) #`(@ #,q) where u)
                      (set! #,p #,q))))]
           [(== (car type) 'slice)
            (let ([items (derive-fresh 'items)] [count (derive-fresh 'count)] [room (derive-fresh 'room)] [w (derive-fresh 'w)]
                  [more (derive-fresh 'more)] [e (type-syntax (cadr type))])
-             #`(let ([#,items (ptr #,e) 0] [#,count u32 0] [#,room u32 0] [#,w u32 0])
+             #`(let ([#,items (ptr #,e) 0] [#,count u32 0] [#,room u32 0] [#,w json-token])
                  (unless (expect! r #,u json-token-start-array "expected an array") (return #f))
                  (while #t
                    (set! #,w (json-next! r))
                    (when (== #,w json-token-end-array) (break))
                    (when (== #,count #,room)
                      (set! #,room (if (== #,room 0) 4 (* 2 #,room)))
-                     (let ([#,more (cast (ptr #,e) (arena-alloc a (* #,room (sizeof #,e))))])
+                     (let ([#,more (-> (new a #,e #,room) items)])
                        (when (> #,count 0) (memcpy #,more #,items (* #,count (sizeof #,e))))
                        (set! #,items #,more)))
                    #,(read-code (cadr type) #`(@ #,items #,count) where w)
@@ -940,7 +931,7 @@
           [(== (car type) 'array)
            (let ([i (derive-fresh 'i)] [w (derive-fresh 'w)] [n (literal (caddr type))]
                  [message (literal (format "expected an array of ~a items" `(,(caddr type))))])
-             #`(let ([#,w u32 0])
+             #`(let ([#,w json-token])
                  (unless (expect! r #,u json-token-start-array "expected an array") (return #f))
                  (for ([#,i u32 0]) (< #,i #,n) (+= #,i 1)
                    (set! #,w (json-next! r))