substrate-lang 0.9.3 → 0.9.4

package/substrate/compiler/expander.sub

@@ -87,7 +87,7 @@
 (const unit-kind u32 20)
 
 (define (new-unit [path datum] [name datum]) -> datum
-  (let ([m (cast (ptr unit) (arena-alloc (& run-arena) (sizeof unit)))])
+  (let ([m (new (& run-arena) unit)])
     (set! (-> m self) (make-record unit-kind m))
     (set! (-> m path) (keep path))
     (set! (-> m name) (keep name))
@@ -122,7 +122,7 @@
 (define namespace-counter u32 0)
 
 (define (new-comp [m datum]) -> (ptr comp)
-  (let ([c (cast (ptr comp) (arena-alloc (current-arena) (sizeof comp)))])
+  (let ([c (new (current-arena) comp)])
     (set! (-> c module) m)
     (set! (-> c use-site-scopes) nil)
     (set! (-> c phase-forms) nil)
@@ -353,19 +353,16 @@
   (cast (ptr binding) (hash-ref (& bindings) (slot-key sym slot))))
 
 (define (bind-raw! [sym datum] [scopes (ptr scope-set)] [phase i32] [meaning datum]) -> (ptr binding)
-  (let ([b (cast (ptr binding) (arena-alloc (& run-arena) (sizeof binding)))] [k (slot-key sym (binding-slot scopes))])
-    (set! (-> b scopes) scopes)
-    (set! (-> b phase) phase)
-    (set! (-> b key) (keep (fresh-key!)))
-    (set! (-> b meaning) (keep meaning))
-    (set! (-> b next) (cast (ptr binding) (hash-ref (& bindings) k)))
+  (let* ([k (slot-key sym (binding-slot scopes))]
+         [b (new (& run-arena) (binding #:scopes scopes #:phase phase #:key (keep (fresh-key!)) #:meaning (keep meaning)
+                                        #:next (cast (ptr binding) (hash-ref (& bindings) k))))])
     (hash-set! (& bindings) k (cast u32 b))
     b))
 
 (define (bind-module-level! [sym datum] [scopes (ptr scope-set)] [phase i32] [meaning datum]) -> (ptr binding)
   (let ([b (bind-raw! sym scopes phase meaning)])
     (when (!= current 0)
-      (let ([e (cast (ptr module-entry) (arena-alloc (& run-arena) (sizeof module-entry)))] [m (the-module)])
+      (let ([e (new (& run-arena) module-entry)] [m (the-module)])
         (set! (-> e symbol) sym)
         (set! (-> e scopes) scopes)
         (set! (-> e phase) phase)
@@ -815,7 +812,7 @@
 (define (imported-kind [kind datum]) -> datum (if (== kind 'memory) 'memory-import 'table-import))
 
 (define (add-wasm-module! [m datum] [phase i32] [compiled datum])
-  (let ([l (cast (ptr wasm-module) (arena-alloc (& run-arena) (sizeof wasm-module)))] [u (unit-of m)])
+  (let ([l (new (& run-arena) wasm-module)] [u (unit-of m)])
     (set! (-> l phase) phase)
     (set! (-> l bytes) (keep (car compiled)))
     (set! (-> l imports) (keep (cadr compiled)))
@@ -1391,10 +1388,7 @@
 (define loading datum 0)
 (define loaded-infos (ptr datum) 0)
 
-(define (zeroed-array [n u32]) -> (ptr datum)
-  (let ([a (cast (ptr datum) (arena-alloc (current-arena) (* 4 (+ n 1))))])
-    (for ([i u32 0]) (< i n) (+= i 1) (set! (@ a i) 0))
-    a))
+(define (zeroed-array [n u32]) -> (ptr datum) (-> (new (current-arena) datum (+ n 1)) items))
 
 (define (load-module! [m datum] [d datum])
   (let* ([u (unit-of m)] [infos (section d 'infos)] [ni (length infos)]
@@ -1423,7 +1417,7 @@
     (for-each (lambda ([e datum])
                 (let* ([scopes (scope-set-of (cadr e))] [phase (cast i32 (integer-value (caddr e)))]
                        [b (bind-raw! (car e) scopes phase (decode (cadddr e)))]
-                       [me (cast (ptr module-entry) (arena-alloc (& run-arena) (sizeof module-entry)))])
+                       [me (new (& run-arena) module-entry)])
                   (set! (-> me symbol) (car e))
                   (set! (-> me scopes) scopes)
                   (set! (-> me phase) phase)
@@ -1520,7 +1514,7 @@
 (define current-body (ptr body) 0)
 
 (define (expand-body [forms datum] [phase i32]) -> datum
-  (let ([b (cast (ptr body) (arena-alloc (current-arena) (sizeof body)))] [saved current-body] [out datum 0])
+  (let ([b (new (current-arena) body)] [saved current-body] [out datum 0])
     (set! (-> b phase) phase)
     (set! (-> b syntax) to-syntax)
     (set! (-> b items) nil)
@@ -2028,29 +2022,27 @@
   (== (host-instantiate name code imports compile-time err) 0))
 
 (define (instantiate! [name datum] [bytes datum] [imports datum] [scopes datum] [t u32] [where datum] [compile-time bool])
-  (let* ([map (import-map imports t)] [n (* 2 (length map))] [pairs (cast (ptr string) (malloc (* n 8)))] [i u32 0] [ok #f]
-         [why string])
+  (let* ([map (import-map imports t)] [n (* 2 (length map))] [pairs (new 0 string n)] [i u32 0] [ok #f] [why string])
     (while (pair? map)
       (set! (@ pairs i) (datum->string (car (car map))))
       (set! (@ pairs (+ i 1)) (datum->string (cdr (car map))))
       (+= i 2)
       (set! map (cdr map)))
     (set-scope-map! (slice (scope-map-of scopes t) (length scopes)))
-    (try (set! ok (instantiate-bytes (datum->string name) (datum->bytes bytes) (slice pairs n) compile-time
-                                     (& why)))
+    (try (set! ok (instantiate-bytes (datum->string name) (datum->bytes bytes) pairs compile-time (& why)))
          [catch compile-error (message blamed loc)
           (set-scope-map! 0)
-          (free pairs)
+          (free (-> pairs items))
           (throw compile-error message blamed loc)])
     (set-scope-map! 0)
-    (free pairs)
+    (free (-> pairs items))
     (unless ok
       (if session-running
           (fail-at where "~a" (list1 (session-failure (host-error why))))
           (fail-at where "compile-time code failed: ~a" (list1 (host-error why)))))))
 
 (define (scope-map-of [scopes datum] [t u32]) -> (ptr u32)
-  (let ([p (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ (length scopes) 1))))] [i u32 0] [sc u32 0] [o datum 0])
+  (let ([p (-> (new (current-arena) u32 (+ (length scopes) 1)) items)] [i u32 0] [sc u32 0] [o datum 0])
     (while (pair? scopes)
       (set! sc (cast u32 (integer-value (car scopes))))
       (set! o (scope-origin sc))
@@ -2881,23 +2873,23 @@
 (define (module-names [m datum]) -> (ptr names)
   (let ([head (-> (unit-of m) entries)] [known (cast (ptr names) (hash-ref (& name-tables) (cast u64 m)))])
     (when (and (!= known 0) (== (-> known upto) head)) (return known))
-    (let ([saved (use-arena (& run-arena))] [n known] [new nil] [e head])
+    (let ([saved (use-arena (& run-arena))] [n known] [added nil] [e head])
       (when (!= n 0)
         (while (and (!= e 0) (!= e (-> n upto)))
-          (set! new (cons (cast datum e) new))
+          (set! added (cons (cast datum e) added))
           (set! e (-> e next)))
         (when (!= e (-> n upto)) (set! n 0)))
       (when (== n 0)
-        (set! n (cast (ptr names) (arena-alloc (& run-arena) (sizeof names))))
+        (set! n (new (& run-arena) names))
         (set! (-> n by-base) (make-table))
         (set! (-> n by-name) (make-table))
         (set! (-> n counts) (make-table))
-        (set! new nil)
+        (set! added nil)
         (set! e head)
         (while (!= e 0)
-          (set! new (cons (cast datum e) new))
+          (set! added (cons (cast datum e) added))
           (set! e (-> e next))))
-      (name-entries! m n new)
+      (name-entries! m n added)
       (set! (-> n upto) head)
       (hash-set! (& name-tables) (cast u64 m) (cast u32 n))
       (use-arena saved)

package/substrate/compiler/link.sub

@@ -251,8 +251,8 @@
         [nkept u32 0] [base u32 0])
     (set! (-> k nf) (+ (-> s nfimports) ndefined))
     (set! (-> k ng) (+ (-> s ngimports) (length (-> s globals))))
-    (set! (-> k fmap) (cast (ptr u32) (malloc (* 4 (+ (-> k nf) 1)))))
-    (set! (-> k gmap) (cast (ptr u32) (malloc (* 4 (+ (-> k ng) 1)))))
+    (set! (-> k fmap) (-> (new 0 u32 (+ (-> k nf) 1)) items))
+    (set! (-> k gmap) (-> (new 0 u32 (+ (-> k ng) 1)) items))
     (set! (-> k kept) nil)
     (set! (-> k hooks) nil)
     (set! (-> k sp) 0)

package/substrate/compiler/ops.sub

@@ -15,7 +15,7 @@
     memory.copy memory.fill))
 
 (define (def! [name datum] [code datum] [params datum] [results datum] [align i32])
-  (let ([op (cast (ptr prim-op) (arena-alloc (& run-arena) (sizeof prim-op)))])
+  (let ([op (new (& run-arena) prim-op)])
     (set! (-> op name) name)
     (set! (-> op code) code)
     (set! (-> op params) params)

package/substrate/compiler/prune.sub

@@ -18,7 +18,7 @@
 (define (unreadable) (raise-compile-error 0 "internal: a program's wasm module cannot be read"))
 
 (define (new-wasm [name datum] [bytes datum]) -> (ptr wasm)
-  (let ([w (cast (ptr wasm) (arena-alloc (current-arena) (sizeof wasm)))] [id u32 0] [head u32 0] [next u32 0])
+  (let ([w (new (current-arena) wasm)] [id u32 0] [head u32 0] [next u32 0])
     (set! (-> w name) name)
     (set! (-> w bytes) (datum->bytes bytes))
     (set! (-> w sections) nil)
@@ -66,20 +66,15 @@
             [(== id 9) (read-elems!)]
             [(== id 10) (read-bodies! w)])
       (set! ss (cdr ss)))
-    (set! (-> w live) (cast (ptr bool) (arena-alloc (current-arena) (+ (-> w nimports) (-> w count) 1))))
-    (memset (-> w live) 0 (+ (-> w nimports) (-> w count) 1))
-    (set! (-> w table-functions) (cast (ptr bool) (arena-alloc (current-arena) (+ (-> w nimports) (-> w count) 1))))
-    (memset (-> w table-functions) 0 (+ (-> w nimports) (-> w count) 1))
+    (set! (-> w live) (-> (new (current-arena) bool (+ (-> w nimports) (-> w count) 1)) items))
+    (set! (-> w table-functions) (-> (new (current-arena) bool (+ (-> w nimports) (-> w count) 1)) items))
     (for-each (lambda ([t datum]) (set! (@ (-> w table-functions) (cast u32 (integer-value (car t)))) #t)) (-> w tables))
-    (set! (-> w valued) (cast (ptr bool) (arena-alloc (current-arena) (+ (-> w nimports) (-> w count) 1))))
-    (memset (-> w valued) 0 (+ (-> w nimports) (-> w count) 1))
-    (set! (-> w read-globals) (cast (ptr bool) (arena-alloc (current-arena) (+ (-> w nglobals) 1))))
-    (memset (-> w read-globals) 0 (+ (-> w nglobals) 1))
-    (set! (-> w read-datas) (cast (ptr bool) (arena-alloc (current-arena) (+ (-> w ndatas) 1))))
-    (memset (-> w read-datas) 0 (+ (-> w ndatas) 1))
+    (set! (-> w valued) (-> (new (current-arena) bool (+ (-> w nimports) (-> w count) 1)) items))
+    (set! (-> w read-globals) (-> (new (current-arena) bool (+ (-> w nglobals) 1)) items))
+    (set! (-> w read-datas) (-> (new (current-arena) bool (+ (-> w ndatas) 1)) items))
     (set! (-> w sites) (make-buffer))
-    (set! (-> w site-starts) (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ (-> w count) 1)))))
-    (set! (-> w site-ends) (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ (-> w count) 1)))))))
+    (set! (-> w site-starts) (-> (new (current-arena) u32 (+ (-> w count) 1)) items))
+    (set! (-> w site-ends) (-> (new (current-arena) u32 (+ (-> w count) 1)) items))))
 
 ;; Each import's span is its kind and its bytes' start and end.
 (define (read-imports! [w (ptr wasm)])
@@ -125,8 +120,8 @@
 (define (read-bodies! [w (ptr wasm)])
   (let ([n (uleb)] [size u32 0])
     (set! (-> w count) n)
-    (set! (-> w starts) (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ n 1)))))
-    (set! (-> w ends) (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ n 1)))))
+    (set! (-> w starts) (-> (new (current-arena) u32 (+ n 1)) items))
+    (set! (-> w ends) (-> (new (current-arena) u32 (+ n 1)) items))
     (for ([k u32 0]) (< k n) (+= k 1)
       (set! size (uleb))
       (set! (@ (-> w starts) k) (position))
@@ -335,7 +330,7 @@
 
 (define (renumber! [w (ptr wasm)])
   (let ([total (+ (-> w nimports) (-> w count))] [next u32 0])
-    (set! (-> w indexes) (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ total 1)))))
+    (set! (-> w indexes) (-> (new (current-arena) u32 (+ total 1)) items))
     (for ([i u32 0]) (< i total) (+= i 1)
       (set! (@ (-> w indexes) i) next)
       (when (@ (-> w live) i) (+= next 1)))))
@@ -371,7 +366,7 @@
 (define (rewritten [w (ptr wasm)]) -> datum
   (let ([out (make-buffer)] [ss (-> w sections)] [news (ptr u32) 0] [s datum 0])
     (renumber! w)
-    (set! news (cast (ptr u32) (arena-alloc (current-arena) (* 4 (+ (-> w count) 1)))))
+    (set! news (-> (new (current-arena) u32 (+ (-> w count) 1)) items))
     (buffer-add! (& out) (slice (-> w bytes) 0 8))
     (while (pair? ss)
       (let* ([sec (car ss)] [id (integer-value (car sec))] [head (cast u32 (integer-value (cadr sec)))]

package/substrate/compiler/roots.sub

@@ -351,9 +351,10 @@
       name
       (string->datum (path-joined (path-windows?) (datum->string dir) (datum->string name)))))
 
-(define (kind-of [path datum]) -> i32
+(define (kind-of [path datum]) -> fs-kind
   (let ([info fs-info])
-    (if (< (fs-stat (datum->string path) (& info) 0) 0) 0 (-> info kind))))
+    (fs-stat (datum->string path) (& info) 0)
+    (-> info kind)))
 
 (define (clean-name? [s string]) -> bool
   (let ([start u32 0])

package/substrate/compiler/serialize.sub

@@ -8,7 +8,7 @@
         [atoms (ptr hash-table)] [pairs (ptr hash-table)] [scopes (ptr hash-table)] [table datum])
 
 (define (make-serializer) -> (ptr serializer)
-  (let ([s (cast (ptr serializer) (arena-alloc (current-arena) (sizeof serializer)))])
+  (let ([s (new (current-arena) serializer)])
     (set! (-> s out) (make-buffer))
     (set! (-> s count) 0)
     (set! (-> s shared) (make-table))

package/substrate/compiler/substrate.sub

@@ -1,6 +1,6 @@
 ;; Substrate in one module: the language, its runtime and its library.
 
-(provide define struct union variant match exception throw try lambda inst typedef const let let* set!
+(provide define struct union variant enum match exception throw try lambda inst typedef const let let* set!
          if return values import supply
          #%datum #%top-interaction #%module-begin
          when unless cond case while for break continue rethrow and or not cast sizeof offsetof array-of slice @ & ->
@@ -14,7 +14,7 @@
          buffer-add-entries! entry-strings
          sqrt fabs floor ceil trunc nearbyint copysign sqrtf fabsf floorf ceilf truncf nearbyintf copysignf
          malloc calloc realloc free try-malloc try-calloc try-realloc memcpy memset memcmp
-         arena make-arena arena-alloc arena-start! arena-free new
+         arena make-arena arena-alloc arena-start! arena-free new copy
          buffer make-buffer buffer-add! buffer-add-byte! buffer-add-string! buffer-add-utf-8! buffer-add-u32! buffer-add-f32!
          buffer-bytes buffer-string
          buffer-reserve buffer-free! buffer-trim! hash-bytes hash-table hash-ref hash-set! hash-clear! hash-free!
@@ -25,9 +25,9 @@
 ;; ---- the forms ----
 
 (define-syntax forms (quote-syntax (#%form forms)))
-(forms #%module-begin #%top-interaction define struct union variant match exception
+(forms #%module-begin #%top-interaction define struct union variant enum match exception
        throw try lambda inst substrate-struct-check typedef const let let* #%datum when unless cond case array-of slice
-       while for cast sizeof offsetof -> & set! @ break continue rethrow new printf test expect expect-equal
+       while for cast sizeof offsetof -> & set! @ break continue rethrow new copy printf test expect expect-equal
        + - * / % == != < <= > >= and or not bit-and bit-or bit-xor bit-not << >>
        += -= *= /= %= <<= >>= bit-and= bit-or= bit-xor=)
 
@@ -44,6 +44,7 @@
     (constant (const NAME TYPE VALUE))
     (type (struct NAME FIELD ...))
     (type (variant NAME CASE ...))
+    (type (enum NAME CASE ...))
     (type (typedef NAME TYPE))
     (exception (exception NAME TYPE ...))
     (macro (define-syntax NAME _))
@@ -183,10 +184,7 @@
 
 ;; ---- strings and slices ----
 
-(define (string-copy [s string]) -> string
-  (let ([p (cast (ptr u8) (malloc (-> s length)))])
-    (memcpy p (-> s bytes) (-> s length))
-    (cast string (slice p (-> s length)))))
+(define (string-copy [s string]) -> string (copy 0 s))
 
 ;; The checker's code calls these to compare strings by their bytes, and to trap on an index or a part out of range.
 
@@ -977,7 +975,7 @@
   (+ ten-powers (* 2 (+ q 348))))
 
 (define (make-ten-powers) -> (ptr u64)
-  (let* ([t (cast (ptr u64) (malloc 11136))] [limbs (array u64 44)] [x (slice limbs)])
+  (let* ([t (-> (new 0 u64 1392) items)] [limbs (array u64 44)] [x (slice limbs)])
     (memset limbs 0 352)
     (set! (@ x 0) 1)
     (for ([q 0]) (<= q 347) (+= q 1)
@@ -1020,10 +1018,7 @@
           [else (bit-or (<< (cast u64 (+ e2 1075)) 52) (- mant 4503599627370496))])))
 
 ;; A number is 32-bit limbs, least significant first, each in a u64.
-(define (big-new [a (ptr arena)] [len u32]) -> (slice u64)
-  (let ([x (cast (ptr u64) (arena-alloc a (* 8 len)))])
-    (memset x 0 (* 8 len))
-    (slice x len)))
+(define (big-new [a (ptr arena)] [len u32]) -> (slice u64) (new a u64 len))
 
 (define (big-mul-add! [x (slice u64)] [k u64] [c u64])
   (for ([i u32 0]) (< i (-> x length)) (+= i 1)

package/substrate/compiler/syntax.sub

@@ -90,7 +90,7 @@
 (define (in-run-arena?) -> bool (== current (& run-arena)))
 
 (define (begin-module-arena)
-  (let ([m (cast (ptr module-arena) (malloc (sizeof module-arena)))])
+  (let ([m (new 0 module-arena)])
     (set! (-> m arena) (make-arena))
     (set! (-> m outer) innermost)
     (set! innermost m)
@@ -302,7 +302,7 @@
 
 ;; ---- tables in an arena ----
 (define (make-table) -> (ptr hash-table)
-  (let ([t (cast (ptr hash-table) (memset (arena-alloc current (sizeof hash-table)) 0 (sizeof hash-table)))])
+  (let ([t (new current hash-table)])
     (set! (-> t arena) current)
     t))
 
@@ -322,7 +322,7 @@
         (set! (-> e value) value)
         (return))
       (set! e (-> e next)))
-    (set! e (cast (ptr entry) (arena-alloc (-> t arena) (sizeof entry))))
+    (set! e (new (-> t arena) entry))
     (set! (-> e key) key)
     (set! (-> e value) value)
     (set! (-> e next) first)
@@ -341,10 +341,7 @@
 (define symbols hash-table)
 (define keywords hash-table)
 
-(define (kept-text [s string]) -> string
-  (let ([p (cast (ptr u8) (arena-alloc (& run-arena) (-> s length)))])
-    (memcpy p (-> s bytes) (-> s length))
-    (cast string (slice p (-> s length)))))
+(define (kept-text [s string]) -> string (copy (& run-arena) s))
 
 (define (held-text [s string]) -> string
   (let ([p (held-bytes (-> s length))])
@@ -519,11 +516,7 @@
 ;; ---- changes to scopes ----
 
 (define (new-change [sc u32] [kind u32] [next (ptr change)]) -> (ptr change)
-  (let ([c (cast (ptr change) (arena-alloc current (sizeof change)))])
-    (set! (-> c scope) sc)
-    (set! (-> c kind) kind)
-    (set! (-> c next) next)
-    c))
+  (new current (change #:scope sc #:kind kind #:next next)))
 
 (define (changes-add [cs (ptr change)] [sc u32] [kind u32]) -> (ptr change)
   (cond [(== cs 0) (new-change sc kind 0)]
@@ -600,13 +593,7 @@
   (make-cell (syntax e scopes loc props 0)))
 
 (define (make-srcloc [source datum] [line u32] [col u32] [pos u32] [span u32]) -> (ptr srcloc)
-  (let ([l (cast (ptr srcloc) (arena-alloc current (sizeof srcloc)))])
-    (set! (-> l source) source)
-    (set! (-> l line) line)
-    (set! (-> l col) col)
-    (set! (-> l pos) pos)
-    (set! (-> l span) span)
-    l))
+  (new current (srcloc #:source source #:line line #:col col #:pos pos #:span span)))
 
 (define (syntax-e [s datum]) #:copied -> datum
   (match (cell-of s)
@@ -730,7 +717,7 @@
 (define (keep-srcloc [l (ptr srcloc)]) -> (ptr srcloc)
   (if (== l 0)
       0
-      (let ([kept (cast (ptr srcloc) (arena-alloc (& run-arena) (sizeof srcloc)))])
+      (let ([kept (new (& run-arena) srcloc)])
         (set! (@ kept) (@ l))
         kept)))
 
@@ -1098,7 +1085,7 @@
 (define (deserialize [bytes (ptr u8)] [n u32]) -> (ptr datum)
   (set! in-bytes bytes)
   (set! in-at 0)
-  (let* ([count (cast u32 (in-uleb))] [objs (cast (ptr u32) (arena-alloc current (* 4 (+ count 1))))])
+  (let* ([count (cast u32 (in-uleb))] [objs (-> (new current u32 (+ count 1)) items)])
     (for ([i u32 0]) (< i count) (+= i 1) (set! (@ objs i) (in-entry objs)))
     (cast (ptr datum) objs)))
 

package/substrate/host/fs.sub

@@ -5,7 +5,7 @@
 ;; 0, or -1 when they fail, and store a failure's reason at err.
 (provide fs-read-file fs-write-file fs-make-dir fs-info fs-stat fs-lstat fs-list fs-remove fs-rename
          fs-read-link fs-real-path fs-symlink fs-copy fs-chmod fs-make-temp-dir fs-make-temp-file
-         fs-cwd fs-file fs-directory fs-link fs-other
+         fs-cwd fs-kind fs-none fs-file fs-directory fs-link fs-other
          fs-open-file fs-read-at fs-write-at fs-set-size fs-sync fs-size fs-close-file fs-read-stream fs-write-stream
          fs-read-flag fs-write-flag fs-append-flag fs-truncate-flag fs-create-flag fs-create-new-flag)
 
@@ -32,20 +32,17 @@
 (import file_stream "fs" "file_stream" (i32 i32 f64 i32 i32 -> i32))
 
 ;; An fs-info's kind.
-(const fs-file i32 1)
-(const fs-directory i32 2)
-(const fs-link i32 3)
-(const fs-other i32 4)
+(enum fs-kind fs-none fs-file fs-directory fs-link fs-other)
 
 ;; modified is in milliseconds since 1970, and mode is the file's mode bits, its type's included.
-(struct fs-info [kind i32] [size i64] [modified f64] [mode u32])
+(struct fs-info [kind fs-kind] [size i64] [modified f64] [mode u32])
 
 (define (fs-make-dir [path string] [err (ptr string)]) -> i32
   (make_dir (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 err)))
 
 (define (stat-of [path string] [follow bool] [i (ptr fs-info)] [err (ptr string)]) -> i32
   (let ([(kind size modified mode) (info (cast i32 (-> path bytes)) (cast i32 (-> path length)) follow (cast i32 err))])
-    (set! (-> i kind) kind)
+    (set! (-> i kind) (cast fs-kind kind))
     (set! (-> i size) (cast i64 size))
     (set! (-> i modified) modified)
     (set! (-> i mode) (cast u32 mode))
@@ -155,11 +152,11 @@
     (when (== h 0) (return -1))
     (set! size (fs-size h err))
     (set! room (if (> size 0) (+ (cast u32 (if (> size 2147483583) 2147483583 size)) 1) 4096))
-    (set! p (cast (ptr u8) (try-malloc room)))
+    (set! p (try-malloc room))
     (while (!= p 0)
       (set! got (fs-read-at h (slice (+ p n) (- room n)) (cast i64 n) err))
       (when (< got 0)
-        (free (cast (ptr void) p))
+        (free p)
         (fs-close-file h 0)
         (return -1))
       (+= n (cast u32 got))
@@ -167,8 +164,8 @@
         (fs-close-file h 0)
         (set! (@ into) (slice p n))
         (return 0))
-      (set! more (cast (ptr u8) (try-realloc (cast (ptr void) p) (* room 2))))
-      (when (== more 0) (free (cast (ptr void) p)))
+      (set! more (try-realloc p (* room 2)))
+      (when (== more 0) (free p))
       (set! p more)
       (set! room (* room 2)))
     (fs-close-file h 0)

package/substrate/host/grants.sub

@@ -8,18 +8,14 @@
 ;;   tls-cert tls-key          a file
 ;; grants-parse! reads flags as people type them, like -R=a,b, where ",," is a comma inside an item, and grants-add! a
 ;; clause as manifests and tests write one, like (read "a" "b"), (all net) or (tls "cert.pem" "key.pem").
-(provide grant grants grant-read grant-write grant-net grant-env grant-run make-grants grants-allow! grants-deny!
+(provide grant grants grant-kind grant-read grant-write grant-net grant-env grant-run make-grants grants-allow! grants-deny!
          grants-allow-all! grants-deny-all! grants-all! grants-inherit! grants-fake! grants-fetch! grants-tls!
          grants-join! grants-parse! grants-flag? grants-add! grants-entries! grants-arguments)
 
 (struct grant [kind string] [item string])
 (struct grants [list buffer])
 
-(const grant-read u32 0)
-(const grant-write u32 1)
-(const grant-net u32 2)
-(const grant-env u32 3)
-(const grant-run u32 4)
+(enum grant-kind grant-read grant-write grant-net grant-env grant-run)
 
 (define (make-grants) -> grants
   (let ([g grants])
@@ -30,22 +26,24 @@
   (let ([e (grant #:kind kind #:item item)])
     (buffer-add! (& (-> g list)) (slice (cast (ptr u8) (& e)) (sizeof grant)))))
 
-(define (allowed [k u32]) -> string (let ([names (array-of string "read" "write" "net" "env" "run")]) (@ names k)))
+(define (allowed [k grant-kind]) -> string
+  (match k [grant-read "read"] [grant-write "write"] [grant-net "net"] [grant-env "env"] [grant-run "run"]))
 
-(define (denied [k u32]) -> string
-  (let ([names (array-of string "deny-read" "deny-write" "deny-net" "deny-env" "deny-run")]) (@ names k)))
+(define (denied [k grant-kind]) -> string
+  (match k [grant-read "deny-read"] [grant-write "deny-write"] [grant-net "deny-net"] [grant-env "deny-env"] [grant-run "deny-run"]))
 
-(define (grants-allow! [g (ptr grants)] [k u32] [item string]) (added! g (allowed k) item))
+(define (grants-allow! [g (ptr grants)] [k grant-kind] [item string]) (added! g (allowed k) item))
 
-(define (grants-deny! [g (ptr grants)] [k u32] [item string]) (added! g (denied k) item))
+(define (grants-deny! [g (ptr grants)] [k grant-kind] [item string]) (added! g (denied k) item))
 
-(define (grants-allow-all! [g (ptr grants)] [k u32]) (added! g "all" (allowed k)))
+(define (grants-allow-all! [g (ptr grants)] [k grant-kind]) (added! g "all" (allowed k)))
 
-(define (grants-deny-all! [g (ptr grants)] [k u32]) (added! g "all" (denied k)))
+(define (grants-deny-all! [g (ptr grants)] [k grant-kind]) (added! g "all" (denied k)))
 
-(define (grants-all! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (grants-allow-all! g k)))
+(define (grants-all! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (grants-allow-all! g (cast grant-kind k))))
 
-(define (grants-inherit! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (added! g "inherit" (allowed k))))
+(define (grants-inherit! [g (ptr grants)])
+  (for ([k u32 0]) (< k 5) (+= k 1) (added! g "inherit" (allowed (cast grant-kind k)))))
 
 (define (grants-fake! [g (ptr grants)] [name string]) (added! g "fake" name))
 
@@ -87,20 +85,20 @@
   (for ([i u32 0]) (< i (-> s length)) (+= i 1) (when (== (@ s i) #\=) (return i)))
   (-> s length))
 
-(define (kind-of [name string] [k (ptr u32)]) -> bool
+(define (kind-of [name string] [k (ptr grant-kind)]) -> bool
   (let ([shorts (array-of string "-R" "-W" "-N" "-E" "--allow-run")]
         [longs (array-of string "--allow-read" "--allow-write" "--allow-net" "--allow-env" "--allow-run")])
     (for ([i u32 0]) (< i 5) (+= i 1)
       (when (or (== name (@ shorts i)) (== name (@ longs i)))
-        (set! (@ k) i)
+        (set! (@ k) (cast grant-kind i))
         (return #t)))
     #f))
 
-(define (denial-of [name string] [k (ptr u32)]) -> bool
+(define (denial-of [name string] [k (ptr grant-kind)]) -> bool
   (let ([names (array-of string "--deny-read" "--deny-write" "--deny-net" "--deny-env" "--deny-run")])
     (for ([i u32 0]) (< i 5) (+= i 1)
       (when (== name (@ names i))
-        (set! (@ k) i)
+        (set! (@ k) (cast grant-kind i))
         (return #t)))
     #f))
 
@@ -160,7 +158,7 @@
 (define (grants-parse! [g (ptr grants)] [flags (slice string)] [err (ptr string)]) -> bool
   (for ([i u32 0]) (< i (-> flags length)) (+= i 1)
     (let* ([flag (@ flags i)] [eq (equals-at flag)] [name (slice flag 0 eq)] [listed (< eq (-> flag length))]
-           [value (if listed (slice flag (+ eq 1) (-> flag length)) "")] [k u32 0])
+           [value (if listed (slice flag (+ eq 1) (-> flag length)) "")] [k grant-kind])
       (cond [(or (== name "-A") (== name "--allow-all"))
              (when listed (return (refused err name " takes no list")))
              (grants-all! g)]
@@ -178,21 +176,22 @@
   #t)
 
 (define (grants-flag? [s string]) -> bool
-  (let ([name (slice s 0 (equals-at s))] [k u32 0])
+  (let ([name (slice s 0 (equals-at s))] [k grant-kind])
     (or (== name "-A") (== name "--allow-all") (kind-of name (& k)) (denial-of name (& k)) (== name "--fake")
         (== name "--tls-cert") (== name "--tls-key"))))
 
 ;; ---- clauses ----
 
-(define (kind-named [name string] [deny bool] [k (ptr u32)]) -> bool
+(define (kind-named [name string] [deny bool] [k (ptr grant-kind)]) -> bool
   (for ([i u32 0]) (< i 5) (+= i 1)
-    (when (== name (if deny (denied i) (allowed i)))
-      (set! (@ k) i)
-      (return #t)))
+    (let ([c (cast grant-kind i)])
+      (when (== name (if deny (denied c) (allowed c)))
+        (set! (@ k) c)
+        (return #t))))
   #f)
 
 (define (grants-add! [g (ptr grants)] [head string] [items (slice string)] [err (ptr string)]) -> bool
-  (let ([k u32 0] [n (-> items length)])
+  (let ([k grant-kind] [n (-> items length)])
     (when (== n 0) (return (refused err head " has no items")))
     (for ([i u32 0]) (< i n) (+= i 1)
       (when (== (-> (@ items i) length) 0) (return (refused err head " has an empty item"))))

package/substrate/host/node/process.sub

@@ -20,11 +20,10 @@
 (const process-source u32 10)
 (const process-exit u32 1)
 (const process-failed u32 2)
-(const process-pipe i32 0)
-(const process-ignore i32 1)
-(const process-inherit i32 2)
+(enum process-stdio process-pipe process-ignore process-inherit)
 
-(struct process-options [dir string] [env (slice string)] [clear bool] [stdin i32] [stdout i32] [stderr i32])
+(struct process-options [dir string] [env (slice string)] [clear bool] [stdin process-stdio] [stdout process-stdio]
+        [stderr process-stdio])
 
 (define (process-options-init! [o (ptr process-options)])
   (set! (-> o dir) "")
@@ -44,8 +43,8 @@
     (buffer-add-entries! (& e) (-> p env))
     (set! id (cast u32 (spawn (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes))
                               (cast i32 (-> a length)) (cast i32 (-> p dir bytes)) (cast i32 (-> p dir length))
-                              (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (-> p stdin) (-> p stdout)
-                              (-> p stderr) (cast i32 tag) (cast i32 err))))
+                              (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (cast i32 (-> p stdin))
+                              (cast i32 (-> p stdout)) (cast i32 (-> p stderr)) (cast i32 tag) (cast i32 err))))
     (buffer-free! (& a))
     (buffer-free! (& e))
     id))