substrate-lang 0.9.2 → 0.9.4

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)
 
@@ -26,36 +26,20 @@
 
 ;; ---- 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)
@@ -72,7 +56,7 @@
 
 (define (json-reader-free! [r (ptr json-reader)]) (buffer-free! (& (-> r scratch))))
 
-(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 +105,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 +118,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 +126,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,14 +140,14 @@
   (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)
@@ -320,14 +304,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)
   (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)))
@@ -369,7 +350,7 @@
              (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)))]
@@ -383,9 +364,7 @@
 
 ;; 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 +576,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 +592,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 +639,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 +647,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 +688,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,16 +706,16 @@
              (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)))
 
@@ -786,7 +765,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 +791,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 +840,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 +897,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 +919,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))

package/std/encoding/wire.sub

@@ -96,11 +96,9 @@
     (unless (take-count! r (& n)) (return #f))
     (let ([s (slice (-> r bytes) (-> r at) (+ (-> r at) n))])
       (unless (utf-8? s) (return (refuse! r start "a string is not UTF-8")))
-      (let ([p (cast (ptr u8) (arena-alloc a n))])
-        (memcpy p (-> s items) n)
-        (set! (@ to) (cast string (slice p n)))
-        (+= (-> r at) n)
-        #t))))
+      (set! (@ to) (cast string (copy a s)))
+      (+= (-> r at) n)
+      #t)))
 
 ;; ---- the wire form ----
 
@@ -210,7 +208,7 @@
              #`(let ([#,present #f])
                  (unless (take-flag! r (& #,present) "an option's tag is neither 0 nor 1") (return #f))
                  (if #,present
-                     (let ([#,q (cast (ptr #,u) (arena-alloc a (sizeof #,u)))])
+                     (let ([#,q (new a #,u)])
                        #,(read-code (cadr type) #`(@ #,q) where)
                        (set! #,p #,q))
                      (set! #,p 0))))]
@@ -218,9 +216,9 @@
            (let ([n (derive-fresh 'n)] [items (derive-fresh 'items)] [i (derive-fresh 'i)] [u (type-syntax (cadr type))])
              #`(let ([#,n u32 0])
                  (unless (take-count! r (& #,n)) (return #f))
-                 (let ([#,items (cast (ptr #,u) (arena-alloc a (* #,n (sizeof #,u))))])
+                 (let ([#,items (new a #,u #,n)])
                    (for ([#,i u32 0]) (< #,i #,n) (+= #,i 1) #,(read-code (cadr type) #`(@ #,items #,i) where))
-                   (set! #,p (slice #,items #,n)))))]
+                   (set! #,p #,items))))]
           [(== (car type) 'array)
            (let ([i (derive-fresh 'i)])
              #`(for ([#,i u32 0]) (< #,i #,(literal (caddr type))) (+= #,i 1)

package/std/http/checks.sub

@@ -200,12 +200,12 @@
 
 ;; The table starts with 64 buckets and doubles, up to most, when three quarters full.
 (define (grow! [l (ptr http-limit)] [size u32])
-  (let ([old (-> l buckets)] [n (-> l size)] [new (cast (ptr bucket) (calloc size (sizeof bucket)))])
+  (let ([old (-> l buckets)] [n (-> l size)] [more (-> (new 0 bucket size) items)])
     (for ([i u32 0]) (< i n) (+= i 1)
       (let ([b (& (@ old i))])
-        (when (-> b used) (memcpy (slot new size (slice (cast (ptr u8) (-> b key)) (-> b length))) b (sizeof bucket)))))
+        (when (-> b used) (memcpy (slot more size (slice (cast (ptr u8) (-> b key)) (-> b length))) b (sizeof bucket)))))
     (free old)
-    (set! (-> l buckets) new)
+    (set! (-> l buckets) more)
     (set! (-> l size) size)))
 
 (define (bucket-of [l (ptr http-limit)] [key (slice u8)]) -> (ptr bucket)

package/std/http/conditional.sub

@@ -53,13 +53,11 @@
 (define (second-of [ms f64]) -> f64 (* (floor (/ ms 1000.0)) 1000.0))
 
 (define (http-conditional! [r (ptr http-request)] [etag string] [modified f64]) -> bool
-  (let* ([a (& (-> r arena))] [copy (cast (ptr u8) (arena-alloc a (-> etag length)))]
-         [read? (or (== (-> r method) "GET") (== (-> r method) "HEAD"))]
+  (let* ([a (& (-> r arena))] [read? (or (== (-> r method) "GET") (== (-> r method) "HEAD"))]
          [if-match (http-request-header r "if-match")] [if-none-match (http-request-header r "if-none-match")]
          [unmodified (date-of r "if-unmodified-since")] [since (date-of r "if-modified-since")]
          [changed (second-of modified)] [status i32 0])
-    (memcpy copy (-> etag bytes) (-> etag length))
-    (set! (-> r etag) (cast string (slice copy (-> etag length))))
+    (set! (-> r etag) (copy a etag))
     (set! (-> r modified) modified)
     (cond [(> (-> if-match length) 0) (unless (matches? if-match etag #t) (set! status 412))]
           [(and (>= unmodified 0.0) (> modified 0.0) (> changed unmodified)) (set! status 412)])

package/std/http/cookie.sub

@@ -3,16 +3,14 @@
 (require-unqualified "http.sub")
 (require-unqualified "server.sub")
 
-(provide http-cookie http-request-cookie http-set-cookie! http-same-site-lax http-same-site-strict
-         http-same-site-none)
+(provide http-cookie http-request-cookie http-set-cookie! http-same-site http-same-site-default http-same-site-lax
+         http-same-site-strict http-same-site-none)
 
-(const http-same-site-lax i32 1)
-(const http-same-site-strict i32 2)
-(const http-same-site-none i32 3)
+(enum http-same-site http-same-site-default http-same-site-lax http-same-site-strict http-same-site-none)
 
-;; max-age is in seconds: 0 leaves it out, and below 0 ends the cookie now. same-site 0 leaves it out.
+;; max-age is in seconds: 0 leaves it out, and below 0 ends the cookie now. http-same-site-default leaves SameSite out.
 (struct http-cookie [name string] [value string] [path string] [domain string] [max-age i64] [secure bool]
-  [http-only bool] [same-site i32])
+  [http-only bool] [same-site http-same-site])
 
 (define separators string "()<>@,;:\\\"/[]?={}")
 

package/std/http/form.sub

@@ -111,11 +111,11 @@
              (check! (cadr type) name)
              (let ([e (type-syntax (cadr type))])
                (if (upload? (cadr type))
-                   #`(let ([#,q (cast (ptr http-upload) (arena-alloc a (sizeof http-upload)))])
+                   #`(let ([#,q (new a http-upload)])
                        (set! #,p (if (file parts #,key 0 #,q) #,q 0)))
                    #`(let ([#,s string])
                        (if (text pairs parts #,key 0 (& #,s))
-                           (let ([#,q (cast (ptr #,e) (arena-alloc a (sizeof #,e)))])
+                           (let ([#,q (new a #,e)])
                              #,(value-code (cadr type) s #`(@ #,q) key)
                              (set! #,p #,q))
                            (set! #,p 0)))))]
@@ -123,17 +123,14 @@
              (check! (cadr type) name)
              (let ([e (type-syntax (cadr type))])
                (if (upload? (cadr type))
-                   #`(let* ([#,n (files parts #,key)]
-                            [#,items (cast (ptr http-upload) (arena-alloc a (* #,n (sizeof http-upload))))])
-                       (for ([#,k u32 0]) (< #,k #,n) (+= #,k 1) (file parts #,key #,k (+ #,items #,k)))
-                       (set! #,p (slice #,items #,n)))
-                   #`(let* ([#,n (texts pairs parts #,key)]
-                            [#,items (cast (ptr #,e) (arena-alloc a (* #,n (sizeof #,e))))]
-                            [#,s string])
+                   #`(let* ([#,n (files parts #,key)] [#,items (new a http-upload #,n)])
+                       (for ([#,k u32 0]) (< #,k #,n) (+= #,k 1) (file parts #,key #,k (& (@ #,items #,k))))
+                       (set! #,p #,items))
+                   #`(let* ([#,n (texts pairs parts #,key)] [#,items (new a #,e #,n)] [#,s string])
                        (for ([#,k u32 0]) (< #,k #,n) (+= #,k 1)
                          (text pairs parts #,key #,k (& #,s))
                          #,(value-code (cadr type) s #`(@ #,items #,k) key))
-                       (set! #,p (slice #,items #,n)))))]
+                       (set! #,p #,items))))]
             [(== type 'bool)
              #`(let ([#,s string])
                  (if (text pairs parts #,key 0 (& #,s))

package/std/http/http.sub

@@ -18,18 +18,11 @@
 (struct http-head [line buffer] [names (ptr string)] [values (ptr string)] [room u32] [count u32]
   [method string] [target string] [version string] [status i32] [reason string])
 
-(const state-head i32 0)
-(const state-length i32 1)
-(const state-chunk-size i32 2)
-(const state-chunk-data i32 3)
-(const state-chunk-end i32 4)
-(const state-trailers i32 5)
-(const state-until-close i32 6)
-(const state-stopped i32 7)
-(const state-refused i32 8)
-(const state-no-body i32 9)
-
-(struct http-parser [head http-head] [line buffer] [state i32] [remaining i64] [excess i64] [user (ptr void)]
+(enum parser-state
+  state-head state-length state-chunk-size state-chunk-data state-chunk-end state-trailers state-until-close
+  state-stopped state-refused state-no-body)
+
+(struct http-parser [head http-head] [line buffer] [state parser-state] [remaining i64] [excess i64] [user (ptr void)]
   [on-head (fn ((ptr http-parser)))] [on-body (fn ((ptr http-parser) (slice u8)))] [on-end (fn ((ptr http-parser)))])
 
 ;; ---- text ----
@@ -102,14 +95,14 @@
         (when (and (< i n) (== (@ value i) #\=))
           (+= i 1)
           (if (and (< i n) (== (@ value i) #\"))
-              (let ([p (cast (ptr u8) (arena-alloc a (- n i)))] [k u32 0])
+              (let ([p (new a u8 (- n i))] [k u32 0])
                 (+= i 1)
                 (while (and (< i n) (!= (@ value i) #\"))
                   (when (and (== (@ value i) #\\) (< (+ i 1) n)) (+= i 1))
                   (set! (@ p k) (@ value i))
                   (+= k 1)
                   (+= i 1))
-                (set! found (cast string (slice p k))))
+                (set! found (cast string (slice p 0 k))))
               (begin
                 (set! start i)
                 (while (and (< i n) (!= (@ value i) #\;)) (+= i 1))
@@ -201,22 +194,22 @@
 
 ;; to becomes a copy of from with its own text and room for just its headers, which http-head-free! frees.
 (define (http-head-copy! [to (ptr http-head)] [from (ptr http-head)])
-  (let ([old (-> from line bytes)] [new (ptr u8) 0] [n (-> from count)])
+  (let ([old (-> from line bytes)] [text (ptr u8) 0] [n (-> from count)])
     (set! (-> to line) (make-buffer))
     (buffer-add! (& (-> to line)) (buffer-bytes (& (-> from line))))
-    (set! new (-> to line bytes))
-    (set! (-> to names) (cast (ptr string) (malloc (* n (sizeof string)))))
-    (set! (-> to values) (cast (ptr string) (malloc (* n (sizeof string)))))
+    (set! text (-> to line bytes))
+    (set! (-> to names) (-> (new 0 string n) items))
+    (set! (-> to values) (-> (new 0 string n) items))
     (set! (-> to room) n)
     (for ([i u32 0]) (< i (-> from count)) (+= i 1)
-      (set! (@ (-> to names) i) (moved (@ (-> from names) i) old new))
-      (set! (@ (-> to values) i) (moved (@ (-> from values) i) old new)))
+      (set! (@ (-> to names) i) (moved (@ (-> from names) i) old text))
+      (set! (@ (-> to values) i) (moved (@ (-> from values) i) old text)))
     (set! (-> to count) (-> from count))
-    (set! (-> to method) (moved (-> from method) old new))
-    (set! (-> to target) (moved (-> from target) old new))
-    (set! (-> to version) (moved (-> from version) old new))
+    (set! (-> to method) (moved (-> from method) old text))
+    (set! (-> to target) (moved (-> from target) old text))
+    (set! (-> to version) (moved (-> from version) old text))
     (set! (-> to status) (-> from status))
-    (set! (-> to reason) (moved (-> from reason) old new))))
+    (set! (-> to reason) (moved (-> from reason) old text))))
 
 (define (moved [s string] [old (ptr u8)] [new (ptr u8)]) -> string
   (if (== (-> s length) 0) "" (cast string (slice (+ new (- (cast u32 (-> s bytes)) (cast u32 old))) (-> s length)))))

package/std/http/multipart.sub

@@ -27,10 +27,10 @@
     -1))
 
 (define (joined [a (ptr arena)] [front string] [back string]) -> string
-  (let ([p (cast (ptr u8) (arena-alloc a (+ (-> front length) (-> back length))))])
-    (memcpy p (-> front bytes) (-> front length))
-    (memcpy (+ p (-> front length)) (-> back bytes) (-> back length))
-    (cast string (slice p (+ (-> front length) (-> back length))))))
+  (let ([p (new a u8 (+ (-> front length) (-> back length)))])
+    (memcpy (-> p items) (-> front bytes) (-> front length))
+    (memcpy (+ (-> p items) (-> front length)) (-> back bytes) (-> back length))
+    (cast string p)))
 
 (define (base-name [s string]) -> string
   (let ([i (-> s length)])
@@ -97,7 +97,7 @@
         (when (> (-> part name length) 0)
           (when (== count room)
             (set! room (if (== room 0) 4 (* 2 room)))
-            (let ([more (cast (ptr multipart-part) (arena-alloc a (* room (sizeof multipart-part))))])
+            (let ([more (-> (new a multipart-part room) items)])
               (when (> count 0) (memcpy more items (* count (sizeof multipart-part))))
               (set! items more)))
           (set! (@ items count) part)

package/std/http/route.sub

@@ -18,20 +18,20 @@
 (define (route-rest [a (ptr arena)] [segments (slice string)] [i u32]) -> string
   (let ([n u32 0] [at u32 0])
     (for ([k u32 i]) (< k (-> segments length)) (+= k 1) (+= n (+ (-> (@ segments k) length) 1)))
-    (let ([p (cast (ptr u8) (arena-alloc a n))])
+    (let ([p (new a u8 n)])
       (for ([k u32 i]) (< k (-> segments length)) (+= k 1)
         (when (> k i)
           (set! (@ p at) #\/)
           (+= at 1))
-        (memcpy (+ p at) (-> (@ segments k) bytes) (-> (@ segments k) length))
+        (memcpy (+ (-> p items) at) (-> (@ segments k) bytes) (-> (@ segments k) length))
         (+= at (-> (@ segments k) length)))
-      (cast string (slice p at)))))
+      (cast string (slice p 0 at)))))
 
 (define (route-slashed [a (ptr arena)] [segments (slice string)]) -> (slice string)
-  (let* ([n (-> segments length)] [items (cast (ptr string) (arena-alloc a (* (+ n 1) (sizeof string))))])
+  (let* ([n (-> segments length)] [items (new a string (+ n 1))])
     (for ([i u32 0]) (< i n) (+= i 1) (set! (@ items i) (@ segments i)))
     (set! (@ items n) "")
-    (slice items (+ n 1))))
+    items))
 
 (define (route-moved! [r (ptr http-request)] [path string])
   (let ([b (make-buffer)] [target (-> r target)])
@@ -440,7 +440,7 @@
                            #,@(if (== body 0)
                                   `(,#`(unless (route-typed? r #,(literal (boolean (!= json 0)))) (return)))
                                   nil)
-                           (let ([#,args (cast (ptr #,given) (arena-alloc (& (-> r arena)) (sizeof #,given)))])
+                           (let ([#,args (new (& (-> r arena)) #,given)])
                              #,@(for/list ([x values]) #`(set! (-> #,args #,x) #,x))
                              (set! (-> r route) (cast (ptr void) #,args))
                              (http-read-body! r #,(if (== limit 0) (number 0) limit) #,read)))
@@ -448,7 +448,7 @@
            [start #`(define (#,(start-of r) [r (ptr http-request)] #,@(formals ps))
                       #,(if (== query 0)
                             ending
-                            #`(let ([#,q (cast (ptr #,query) (arena-alloc (& (-> r arena)) (sizeof #,query)))]
+                            #`(let ([#,q (new (& (-> r arena)) #,query)]
                                     [#,e form-error])
                                 (unless (#,(derived query '"form-read" 'form where) (& (-> r arena))
                                          (url-form-parse (& (-> r arena)) (url-query (-> r target))) no-parts #,q
@@ -462,14 +462,14 @@
                  (let* ([#,args (cast (ptr #,given) (-> r route))] #,@(for/list ([x values]) #`[#,x (-> #,args #,x)]))
                    #,(cond [(!= body 0) (handler-call handler values `(,#'bytes))]
                            [(!= json 0)
-                            #`(let ([#,value (cast (ptr #,json) (arena-alloc (& (-> r arena)) (sizeof #,json)))]
+                            #`(let ([#,value (new (& (-> r arena)) #,json)]
                                     [#,e json-error])
                                 (unless (#,(derived json '"json-read" 'json where) (& (-> r arena)) (cast string bytes)
                                          #,value (& #,e))
                                   (return (route-json-refused! r (& #,e))))
                                 #,(handler-call handler values `(,value)))]
                            [else
-                            #`(let ([#,value (cast (ptr #,form) (arena-alloc (& (-> r arena)) (sizeof #,form)))]
+                            #`(let ([#,value (new (& (-> r arena)) #,form)]
                                     [#,e form-error] [pairs (slice url-pair)] [parts (slice multipart-part)])
                                 (unless (route-form-fields r bytes (& pairs) (& parts)) (return))
                                 (unless (#,(derived form '"form-read" 'form where) (& (-> r arena)) pairs parts #,value