substrate-lang 0.9.3 → 0.10.0

package/substrate/compiler/compile.sub

@@ -111,7 +111,7 @@
 ;; ---- per-function state ----
 
 (define (new-fctx [params datum] [results datum]) -> (ptr fctx)
-  (let ([fc (cast (ptr fctx) (arena-alloc (current-arena) (sizeof fctx)))])
+  (let ([fc (new (current-arena) fctx)])
     (set! (-> fc locals) (make-table))
     (set! (-> fc extra) nil)
     (set! (-> fc next) 0)
@@ -147,7 +147,7 @@
 (define compiling datum 0)
 
 (define (push-label [key datum] [kind datum] [type datum] [next (ptr label)]) -> (ptr label)
-  (let ([l (cast (ptr label) (arena-alloc (current-arena) (sizeof label)))])
+  (let ([l (new (current-arena) label)])
     (set! (-> l key) key)
     (set! (-> l kind) kind)
     (set! (-> l type) type)
@@ -177,7 +177,7 @@
 (define (synth-of [d datum]) -> (ptr synth) (cast (ptr synth) (record-pointer d)))
 
 (define (new-mstate [self datum]) -> (ptr mstate)
-  (let ([ms (cast (ptr mstate) (arena-alloc (current-arena) (sizeof mstate)))])
+  (let ([ms (new (current-arena) mstate)])
     (set! (-> ms self) self)
     (set! (-> ms func-imports) nil)
     (set! (-> ms global-imports) nil)
@@ -240,7 +240,7 @@
     (set! (-> ms table-loc) current-loc)))
 
 (define (new-synth! [ms (ptr mstate)] [kind datum] [info datum]) -> datum
-  (let ([s (cast (ptr synth) (arena-alloc (current-arena) (sizeof synth)))])
+  (let ([s (new (current-arena) synth)])
     (set! (-> s self) (make-record-in (current-arena) synth-kind s))
     (set! (-> s kind) kind)
     (set! (-> s info) info)
@@ -626,7 +626,7 @@
 
 (define (compile-function [ms (ptr mstate)] [info datum] [params datum] [body datum]) -> (ptr compiled)
   (let ([fc (new-fctx params (func-info-results info))]
-        [cf (cast (ptr compiled) (arena-alloc (current-arena) (sizeof compiled)))])
+        [cf (new (current-arena) compiled)])
     (set! (-> ms fname) (func-info-name info))
     (set! compiling (func-info-name info))
     (set! current-loc 0)
@@ -757,7 +757,7 @@
                 (set-tag-info-export! (cadr f) (export-name! ms (tag-info-name (cadr f)))))
               tag-forms)
     (set! constants (constant-inits ms global-forms))
-    (set! last (cast (ptr compiled) (arena-alloc (current-arena) (sizeof compiled))))
+    (set! last (new (current-arena) compiled))
     (set! (-> last next) 0)
     (set! first last)
     (for-each (lambda ([f datum])
@@ -814,7 +814,7 @@
 (define (table-functions! [ms (ptr mstate)] [last (ptr compiled)] [segment i64]) -> (ptr compiled)
   (let ([ts (reverse (-> ms tables))])
     (while (pair? ts)
-      (let ([t (car ts)] [a (new-asm)] [cf (cast (ptr compiled) (arena-alloc (current-arena) (sizeof compiled)))])
+      (let ([t (car ts)] [a (new-asm)] [cf (new (current-arena) compiled)])
         (instr! a `(i32.const ,(caddr t)))
         (instr! a `(call ,(list-ref t 4)))
         (instr! a `(global.set ,(car t)))
@@ -933,9 +933,9 @@
 ;; ---- linking ----
 
 (define (index-of [t (ptr hash-table)] [key datum] [what string]) -> datum
-  (let ([i (hash-ref t (cast u64 key))])
+  (let ([i (hash-find t (cast u64 key))])
     (when (== i 0) (fail "internal: ~a has no index" (cons (string->datum what) nil)))
-    (small (- i 1))))
+    (small (@ i))))
 
 (define (type-index [lk (ptr linker)] [sig datum]) -> datum
   (let ([known (datum-get (-> lk func-type-index) sig)])
@@ -965,7 +965,7 @@
 
 (define (number! [t (ptr hash-table)] [items datum] [n u32]) -> u32
   (while (pair? items)
-    (hash-set! t (cast u64 (car items)) (+ n 1))
+    (hash-set! t (cast u64 (car items)) n)
     (+= n 1)
     (set! items (cdr items)))
   n)
@@ -973,7 +973,7 @@
 (define (link-module [ms (ptr mstate)] [compiled (ptr compiled)] [start-fc (ptr fctx)] [setup (ptr asm)]
                      [literal-segment datum] [global-forms datum] [tag-forms datum] [memory-form datum]
                      [table-form datum] [constants (ptr hash-table)]) -> datum
-  (let* ([lk (cast (ptr linker) (arena-alloc (current-arena) (sizeof linker)))]
+  (let* ([lk (new (current-arena) linker)]
          [has-start (or (> (asm-size setup) 0) (> (asm-size (-> start-fc asm)) 0))]
          [func-imports (reverse (-> ms func-imports))]
          [global-imports (reverse (-> ms global-imports))]

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))
@@ -113,7 +113,7 @@
 (struct comp [module datum] [use-site-scopes datum] [phase-forms datum] [memories datum]
         [tables datum] [provide-ids datum] [require-names datum]
         [ns datum] [instances (ptr hash-table)] [values (ptr hash-table)] [wasm-module-counter u32] [storage-wasm-modules datum]
-        [checking (ptr void)] [language datum] [expansions (ptr hash-table)] [scopes (ptr hash-table)])
+        [checking (ptr void)] [language datum])
 
 (define current (ptr comp) 0)
 
@@ -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)
@@ -138,8 +138,6 @@
     (set! (-> c storage-wasm-modules) nil)
     (set! (-> c checking) 0)
     (set! (-> c language) 0)
-    (set! (-> c expansions) (make-table))
-    (set! (-> c scopes) (make-table))
     c))
 
 ;; Scopes for local binding forms get odd numbers, and all other scopes get even numbers. This lets
@@ -353,19 +351,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 +810,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)))
@@ -1048,8 +1043,8 @@
 (define (write-data [path datum] [d datum]) -> bool
   (let ([b (make-buffer)] [temp string] [ok #f])
     (sealed! (& b) d)
-    (when (>= (fs-make-temp-file (datum->string cache-directory) "" ".tmp" (& temp) 0) 0)
-      (set! ok (and (>= (fs-write-file temp (buffer-bytes (& b)) 0) 0) (>= (fs-rename temp (datum->string path) 0) 0)))
+    (when (fs-make-temp-file (datum->string cache-directory) "" ".tmp" (& temp) 0)
+      (set! ok (and (fs-write-file temp (buffer-bytes (& b)) 0) (fs-rename temp (datum->string path) 0)))
       (unless ok (fs-remove temp #f 0))
       (free (-> temp bytes)))
     (buffer-free! (& b))
@@ -1333,13 +1328,13 @@
                (own-ref info))])))
 
 (define (own-ref [info datum]) -> datum
-  (let ([i (hash-ref own-numbers (cast u64 info))])
-    (when (== i 0)
-      (set! own-list (cons info own-list))
-      (+= own-count 1)
-      (set! i own-count)
-      (hash-set! own-numbers (cast u64 info) i))
-    `(own ,(make-integer (- i 1)))))
+  (let ([known (hash-find own-numbers (cast u64 info))] [i own-count])
+    (if (!= known 0)
+        (set! i (@ known))
+        (begin (set! own-list (cons info own-list))
+               (+= own-count 1)
+               (hash-set! own-numbers (cast u64 info) i)))
+    `(own ,(make-integer i))))
 
 (define (info->list [info datum]) -> datum
   (cond [(func-info? info)
@@ -1391,10 +1386,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 +1415,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 +1512,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)
@@ -1866,12 +1858,12 @@
 (define (included-text [s datum]) -> datum
   (let ([l (syntax->list s)])
     (unless (and (!= l 0) (== (length l) 2) (string-literal? (cadr l))) (no-match s "(include-text \"file\")"))
-    (let* ([spec (cadr l)] [from (module-source-file s spec)] [id (module-path-from from spec)] [why string]
+    (let* ([spec (cadr l)] [from (module-source-file s spec)] [id (module-path-from from spec)] [why error]
            [b (slice u8)] [text datum 0] [me (the-module)])
       (check-module! (if (in-session?) 0 (-> me path)) id spec)
       (note-resolved! from (syntax-e spec) id)
-      (when (< (fs-read-file (datum->string (host-file id)) (& b) (& why)) 0)
-        (fail-at spec "cannot read ~s: ~a" `(,(syntax-e spec) ,(host-error why))))
+      (unless (fs-read-file (datum->string (host-file id)) (& b) (& why))
+        (fail-at spec "cannot read ~s: ~a" `(,(syntax-e spec) ,(host-error (& why)))))
       (set! text (string->datum (cast string b)))
       (free (-> b items))
       (when (== (assoc id (-> me included)) 0)
@@ -2023,34 +2015,32 @@
         (ensure-wasm-module! (car l) 0 t)
         (set! l (cdr l))))))
 
-(define (instantiate-bytes [name string] [code (slice u8)] [imports (slice string)] [compile-time bool] [err (ptr string)])
-  -> bool
-  (== (host-instantiate name code imports compile-time err) 0))
+(define (instantiate-bytes [name string] [code (slice u8)] [imports (slice string)] [compile-time bool]
+                           [err (ptr error)]) -> bool
+  (host-instantiate name code imports compile-time err))
 
 (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 error])
     (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)))))))
+          (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))
@@ -2175,14 +2165,9 @@
           [(and (!= m 0) (or (== (car m) 'core) (== (car m) 'prim))) (shape-of (cadr m) s api-phase)]
           [else 0])))
 
-(define (query-scope-shape [m datum] [remember bool]) -> datum
-  (let ([known (if remember (cast datum (hash-ref (-> current scopes) (cast u64 (cadr m)))) 0)])
-    (if (!= known 0)
-        known
-        (begin
-          (scope-shape m api-phase nil)
-          (when remember (hash-set! (-> current scopes) (cast u64 (cadr m)) (cast u32 m)))
-          m))))
+(define (query-scope-shape [m datum]) -> datum
+  (scope-shape m api-phase nil)
+  m)
 
 ;; ---- checked code ----
 
@@ -2712,9 +2697,9 @@
 
 (define (query-inline-call [info datum] [args datum]) -> datum (inline-call info args api-phase))
 
-(define (query-expand-head [s datum] [remember bool]) -> datum (expand-head s api-phase remember))
+(define (query-expand-head [s datum]) -> datum (expand-head s api-phase))
 
-(define (expand-head [s datum] [phase i32] [remember bool]) -> datum
+(define (expand-head [s datum] [phase i32]) -> datum
   (let ([e (syntax-e s)])
     (cond
       [(symbol? e)
@@ -2725,7 +2710,7 @@
            [('compile-time-value)
             (let ([t (transformer-of m)])
               (when (== t 0) (fail-at s "~a is bound to a compile-time value: read it with syntax-local-value" (list1 e)))
-              (head-transformer s t s phase remember))]
+              (head-transformer s t s phase))]
            [('func) `(func ,(cadr m))]
            [('tag) (fail-at s "~a is a tag: throw it with (throw ~a arg ...)" `(,e ,e))]
            [('core 'prim) (fail-at s "bad use of ~a" (list1 e))]
@@ -2733,7 +2718,7 @@
            [else (unbound s e phase)]))]
       [(pair? e)
        (let* ([head (car e)] [m (if (identifier? head) (meaning-of head phase) 0)] [t (transformer-of m)])
-         (cond [(!= t 0) (head-transformer head t s phase remember)]
+         (cond [(!= t 0) (head-transformer head t s phase)]
                [(and (!= m 0) (== (car m) 'core) (== (cadr m) 'include-text)) `(macro ,(included-text s))]
                [(and (!= m 0) (== (car m) 'core)) `(core ,(cadr m) ,s)]
                [(and (!= m 0) (== (car m) 'prim)) `(prim ,(cadr m) ,s)]
@@ -2742,38 +2727,27 @@
                   (if (!= m 0)
                       (fail-at s "#%app is bound here, but not to a macro or the core form" nil)
                       (unbound head '#%app phase)))
-                (expand-head (syntax-rewrap s (cons (implicit-id s '#%app) e)) phase remember)]))]
+                (expand-head (syntax-rewrap s (cons (implicit-id s '#%app) e)) phase)]))]
       [(null? e) (fail-at s "empty form ()" nil)]
       [(literal? e)
        (let* ([id (implicit-id s '#%datum)] [m (meaning-of id phase)] [t (transformer-of m)] [form (syntax-rewrap s `(,id ,s))])
-         (cond [(!= t 0) (head-transformer id t form phase remember)]
+         (cond [(!= t 0) (head-transformer id t form phase)]
                [(and (!= m 0) (== (car m) 'core)) `(core #%datum ,form)]
                [else (fail-at s "the literal ~s needs #%datum, which is ~a here"
                               `(,(syntax->datum s) ,(if (!= m 0) '"not a macro or the core form" '"unbound")))]))]
       [(keyword? e) (fail-at s "~s: keyword misused as an expression" (list1 e))]
       [else (fail-at s "~s is not an expression" (list1 (syntax->datum s)))])))
 
-(define (head-transformer [head datum] [t datum] [s datum] [phase i32] [remember bool]) -> datum
+(define (head-transformer [head datum] [t datum] [s datum] [phase i32]) -> datum
   (if (form-value? t)
       (let ([l (syntax->list t)]) `(form ,(syntax-e (cadr l)) ,(if (pair? (cddr l)) (caddr l) 0) ,s ,t))
-      `(macro ,(if remember (remembered-expansion head t s phase) (apply-macro head t s phase #f)))))
+      `(macro ,(apply-macro head t s phase #f))))
 
-(define (query-apply-form [t datum] [s datum] [remember bool]) -> datum
-  (if remember
-      (remembered-expansion (if (pair? (syntax-e s)) (car (syntax-e s)) s) t s api-phase)
-      (apply-form t s api-phase)))
+(define (query-apply-form [t datum] [s datum]) -> datum (apply-form t s api-phase))
 
 (define (apply-form [t datum] [s datum] [phase i32]) -> datum
   (apply-macro (if (pair? (syntax-e s)) (car (syntax-e s)) s) t s phase #f))
 
-(define (remembered-expansion [head datum] [t datum] [s datum] [phase i32]) -> datum
-  (let ([known (cast datum (hash-ref (-> current expansions) (cast u64 s)))])
-    (if (!= known 0)
-        known
-        (let ([x (apply-macro head t s phase #f)])
-          (hash-set! (-> current expansions) (cast u64 s) (cast u32 x))
-          x))))
-
 (define (query-local-expand [s datum]) -> datum
   (unless (syntax? s) (fail-at api-where "local-expand: expected syntax" nil))
   (let ([saved-output to-syntax] [out datum 0])
@@ -2881,23 +2855,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)
@@ -2966,7 +2940,7 @@
   (fail-at s "unbound identifier ~a~a" `(,sym ,(if (> phase 0) (format " at phase ~a" (list1 (make-integer phase))) '""))))
 
 (define (expand-expr [s datum] [phase i32]) -> datum
-  (let ([h (expand-head s phase #f)])
+  (let ([h (expand-head s phase)])
     (case (car h)
       [('local) (with-local-binding s (cadr h))]
       [('global 'func) (with-local-binding s 0)]

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/main.sub

@@ -39,22 +39,22 @@
     path))
 
 (define (write-file [path datum] [b (slice u8)])
-  (let ([why string])
-    (when (< (fs-write-file (datum->string path) b (& why)) 0)
-      (raise-compile-error 0 (format-message "cannot write ~a" (cons (host-error why) nil))))))
+  (let ([why error])
+    (unless (fs-write-file (datum->string path) b (& why))
+      (raise-compile-error 0 (format-message "cannot write ~a" (cons (host-error (& why)) nil))))))
 
 (define (read-file [path datum]) -> datum
-  (let ([b (slice u8)] [why string] [s datum 0])
-    (when (< (fs-read-file (datum->string path) (& b) (& why)) 0)
-      (raise-compile-error 0 (format-message "cannot read ~a" (cons (host-error why) nil))))
+  (let ([b (slice u8)] [why error] [s datum 0])
+    (unless (fs-read-file (datum->string path) (& b) (& why))
+      (raise-compile-error 0 (format-message "cannot read ~a" (cons (host-error (& why)) nil))))
     (set! s (string->datum (cast string b)))
     (free (-> b items))
     s))
 
 (define (make-dir [path datum])
-  (let ([why string])
-    (when (< (fs-make-dir (datum->string path) (& why)) 0)
-      (raise-compile-error 0 (format-message "cannot make ~a" (cons (host-error why) nil))))))
+  (let ([why error])
+    (unless (fs-make-dir (datum->string path) (& why))
+      (raise-compile-error 0 (format-message "cannot make ~a" (cons (host-error (& why)) nil))))))
 
 (define (joined [strings datum]) -> datum
   (let ([b (make-buffer)] [s datum 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/reader.sub

@@ -269,10 +269,10 @@
     head))
 
 (define (read-file [path datum]) -> datum
-  (let* ([why string] [b (slice u8)] [forms datum 0])
-    (when (< (fs-read-file (datum->string path) (& b) (& why)) 0)
-      (let ([reason (string->datum why)])
-        (free (-> why bytes))
+  (let* ([why error] [b (slice u8)] [forms datum 0])
+    (unless (fs-read-file (datum->string path) (& b) (& why))
+      (let ([reason (string->datum (error-text (& why)))])
+        (error-free! (& why))
         (raise-compile-error 0 (format-message "cannot read ~a" (list1 reason)))))
     (set! forms (read-all (cast string b) (string->symbol (datum->string path))))
     (free (-> b items))

package/substrate/compiler/roots.sub

@@ -37,16 +37,16 @@
   (read-all (datum->string text) source))
 
 (define (file-text [file datum]) -> datum
-  (let* ([why string] [b (slice u8)] [s datum 0])
-    (when (< (fs-read-file (datum->string file) (& b) (& why)) 0)
-      (fail-at 0 "cannot read the module ~a" (list1 (host-error why))))
+  (let* ([why error] [b (slice u8)] [s datum 0])
+    (unless (fs-read-file (datum->string file) (& b) (& why))
+      (fail-at 0 "cannot read the module ~a" (list1 (host-error (& why)))))
     (set! s (string->datum (cast string b)))
     (free (-> b items))
     s))
 
-(define (host-error [why string]) -> datum
-  (let ([s (string->datum why)])
-    (free (-> why bytes))
+(define (host-error [why (ptr error)]) -> datum
+  (let ([s (string->datum (error-text why))])
+    (error-free! why)
     s))
 
 ;; ---- paths ----
@@ -58,7 +58,7 @@
     (if (and (path-absolute? w s) (not (and w (== (path-root w s) "/"))))
         (set! d (string->datum (path-normal w s)))
         (begin
-          (when (< (fs-cwd (& cwd) 0) 0) (fail-at 0 "internal: there is no current directory" nil))
+          (unless (fs-cwd (& cwd) 0) (fail-at 0 "internal: there is no current directory" nil))
           (set! d (string->datum (path-resolved w cwd s)))
           (free (-> cwd bytes))))
     d))
@@ -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])
@@ -486,6 +487,6 @@
   (let ([p (datum->string path)] [info fs-info] [found #f])
     (for ([i u32 1]) (and (not found) (<= i (-> p length))) (+= i 1)
       (when (or (== i (-> p length)) (== (@ p i) #\/))
-        (set! found (and (== (fs-lstat (datum->string (file-in dir (substring path 0 i))) (& info) 0) 0)
+        (set! found (and (fs-lstat (datum->string (file-in dir (substring path 0 i))) (& info) 0)
                          (== (-> info kind) fs-link)))))
     found))

package/substrate/compiler/running.sub

@@ -8,7 +8,7 @@
 
 (define (file-bytes [path datum]) -> datum
   (let ([b (slice u8)] [d datum '#f])
-    (when (== (fs-read-file (datum->string path) (& b) 0) 0)
+    (when (fs-read-file (datum->string path) (& b) 0)
       (set! d (bytes->datum b))
       (free (-> b items)))
     d))