substrate-lang 0.9.4 → 0.10.0

package/substrate/compiler/expander.sub

@@ -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)
 
@@ -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
@@ -1045,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))
@@ -1330,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)
@@ -1860,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)
@@ -2017,12 +2015,12 @@
         (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 (new 0 string n)] [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))))
@@ -2038,8 +2036,8 @@
     (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 (-> (new (current-arena) u32 (+ (length scopes) 1)) items)] [i u32 0] [sc u32 0] [o datum 0])
@@ -2167,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 ----
 
@@ -2704,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)
@@ -2717,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))]
@@ -2725,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)]
@@ -2734,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])
@@ -2958,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/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/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))
@@ -487,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))

package/substrate/compiler/serialize.sub

@@ -20,11 +20,11 @@
     s))
 
 (define (scope-index! [s (ptr serializer)] [sc u32]) -> u32
-  (let ([known (hash-ref (-> s scopes) (+ (cast u64 sc) 1))])
+  (let ([known (hash-find (-> s scopes) (+ (cast u64 sc) 1))])
     (if (!= known 0)
-        (- known 1)
+        (@ known)
         (let ([i (-> (-> s scopes) count)])
-          (hash-set! (-> s scopes) (+ (cast u64 sc) 1) (+ i 1))
+          (hash-set! (-> s scopes) (+ (cast u64 sc) 1) i)
           (set! (-> s table) (cons (make-integer sc) (-> s table)))
           i))))
 
@@ -33,16 +33,23 @@
 (define (added! [s (ptr serializer)] [t (ptr hash-table)] [key u64]) -> u32
   (let ([i (-> s count)])
     (+= (-> s count) 1)
-    (hash-set! t key (+ i 1))
+    (hash-set! t key i)
     i))
 
-(define (shared-index [s (ptr serializer)] [key datum]) -> u32
-  (let ([i (datum-get (-> s shared) key)]) (if (== i 0) 0 (+ (cast u32 (integer-value i)) 1))))
+(struct shared-entry [key datum] [index u32] [next (ptr shared-entry)])
+
+(define (shared-find [s (ptr serializer)] [key datum]) -> (ptr u32)
+  (let ([e (cast (ptr shared-entry) (hash-ref (-> s shared) (datum-hash key)))])
+    (while (!= e 0)
+      (when (equal? (-> e key) key) (return (& (-> e index))))
+      (set! e (-> e next)))
+    0))
 
 (define (shared-added! [s (ptr serializer)] [key datum]) -> u32
-  (let ([i (-> s count)])
+  (let* ([t (-> s shared)] [h (datum-hash key)] [i (-> s count)]
+         [e (new (-> t arena) (shared-entry #:key key #:index i #:next (cast (ptr shared-entry) (hash-ref t h))))])
+    (hash-set! t h (cast u32 e))
     (+= (-> s count) 1)
-    (datum-put! (-> s shared) key (make-integer i))
     i))
 
 (define (bytes! [p (ptr buffer)] [b (slice u8)])
@@ -52,70 +59,70 @@
 (define (small [n i64]) -> datum (make-integer n))
 
 (define (serialize! [s (ptr serializer)] [d datum]) -> u32
-  (let ([p (& (-> s out))] [i u32 0])
+  (let ([p (& (-> s out))] [known (ptr u32) 0])
     (cond
       [(== d '#f)
-       (set! i (shared-index s `(0)))
-       (if (!= i 0) (- i 1) (begin (buffer-add-byte! p 0) (shared-added! s `(0))))]
+       (set! known (shared-find s `(0)))
+       (if (!= known 0) (@ known) (begin (buffer-add-byte! p 0) (shared-added! s `(0))))]
       [(fixnum? d)
        (let ([key (+ (cast u64 (integer-value d)) 1099511627776)])
-         (set! i (hash-ref (-> s fixnums) key))
-         (if (!= i 0)
-             (- i 1)
+         (set! known (hash-find (-> s fixnums) key))
+         (if (!= known 0)
+             (@ known)
              (begin (buffer-add-byte! p 1) (write-sleb p (integer-value d)) (added! s (-> s fixnums) key))))]
       [(integer? d)
        (let* ([negative (integer-negative? d)] [v (integer-value d)]
               [magnitude (if negative (- 0 v) v)]
               [key `(10 ,(small negative) ,(make-unsigned-integer (cast u64 magnitude)))])
-         (set! i (shared-index s key))
-         (if (!= i 0)
-             (- i 1)
+         (set! known (shared-find s key))
+         (if (!= known 0)
+             (@ known)
              (begin (buffer-add-byte! p 10)
                     (buffer-add-byte! p negative)
                     (for ([k u32 0]) (< k 8) (+= k 1)
                       (buffer-add-byte! p (cast i32 (bit-and (>> (cast u64 magnitude) (* 8 k)) 255))))
                     (shared-added! s key))))]
       [(== d (boolean #t))
-       (set! i (shared-index s `(2)))
-       (if (!= i 0) (- i 1) (begin (buffer-add-byte! p 2) (shared-added! s `(2))))]
+       (set! known (shared-find s `(2)))
+       (if (!= known 0) (@ known) (begin (buffer-add-byte! p 2) (shared-added! s `(2))))]
       [(null? d)
-       (set! i (shared-index s `(3)))
-       (if (!= i 0) (- i 1) (begin (buffer-add-byte! p 3) (shared-added! s `(3))))]
+       (set! known (shared-find s `(3)))
+       (if (!= known 0) (@ known) (begin (buffer-add-byte! p 3) (shared-added! s `(3))))]
       [(char? d)
        (let ([key `(4 ,d)])
-         (set! i (shared-index s key))
-         (if (!= i 0)
-             (- i 1)
+         (set! known (shared-find s key))
+         (if (!= known 0)
+             (@ known)
              (begin (buffer-add-byte! p 4) (write-uleb p (char->integer d)) (shared-added! s key))))]
       [(pair? d) (serialize-list! s d)]
       [(symbol? d)
-       (set! i (hash-ref (-> s atoms) (cast u64 d)))
-       (if (!= i 0)
-           (- i 1)
+       (set! known (hash-find (-> s atoms) (cast u64 d)))
+       (if (!= known 0)
+           (@ known)
            (begin (buffer-add-byte! p 6) (bytes! p (cast (slice u8) (symbol->string d))) (added! s (-> s atoms) (cast u64 d))))]
       [(string? d)
        (let ([key `(7 ,d)])
-         (set! i (shared-index s key))
-         (if (!= i 0)
-             (- i 1)
+         (set! known (shared-find s key))
+         (if (!= known 0)
+             (@ known)
              (begin (buffer-add-byte! p 7) (bytes! p (cast (slice u8) (datum->string d))) (shared-added! s key))))]
       [(bytes? d)
        (let ([key `(14 ,d)])
-         (set! i (shared-index s key))
-         (if (!= i 0)
-             (- i 1)
+         (set! known (shared-find s key))
+         (if (!= known 0)
+             (@ known)
              (begin (buffer-add-byte! p 14) (bytes! p (datum->bytes d)) (shared-added! s key))))]
       [(keyword? d)
-       (set! i (hash-ref (-> s atoms) (cast u64 d)))
-       (if (!= i 0)
-           (- i 1)
+       (set! known (hash-find (-> s atoms) (cast u64 d)))
+       (if (!= known 0)
+           (@ known)
            (begin (buffer-add-byte! p 13) (bytes! p (cast (slice u8) (keyword->string d))) (added! s (-> s atoms) (cast u64 d))))]
       [(syntax? d) (serialize-syntax! s d)]
       [(flonum? d)
        (let* ([bits (f64-bits (flonum-value d))] [key `(11 ,(make-integer bits))])
-         (set! i (shared-index s key))
-         (if (!= i 0)
-             (- i 1)
+         (set! known (shared-find s key))
+         (if (!= known 0)
+             (@ known)
              (begin (buffer-add-byte! p 11)
                     (for ([k u32 0]) (< k 8) (+= k 1)
                       (buffer-add-byte! p (cast i32 (bit-and (>> (cast u64 bits) (* 8 k)) 255))))
@@ -123,7 +130,7 @@
       [else (raise-compile-error 0 (format-message "internal: serialize: cannot quote ~s" (cons d nil))) 0])))
 
 (define (serialize-list! [s (ptr serializer)] [d datum]) -> u32
-  (let ([cars nil] [l d] [b u32 0] [key u64 0] [i u32 0] [p (& (-> s out))])
+  (let ([cars nil] [l d] [b u32 0] [key u64 0] [known (ptr u32) 0] [p (& (-> s out))])
     (while (pair? l)
       (set! cars (cons (make-integer (serialize! s (car l))) cars))
       (set! l (cdr l)))
@@ -131,9 +138,9 @@
     (while (pair? cars)
       (let ([a (cast u32 (integer-value (car cars)))])
         (set! key (bit-or (<< (+ (cast u64 a) 1) 32) b))
-        (set! i (hash-ref (-> s pairs) key))
-        (set! b (if (!= i 0)
-                    (- i 1)
+        (set! known (hash-find (-> s pairs) key))
+        (set! b (if (!= known 0)
+                    (@ known)
                     (begin (buffer-add-byte! p 5) (write-uleb p a) (write-uleb p b) (added! s (-> s pairs) key)))))
       (set! cars (cdr cars)))
     b))
@@ -144,10 +151,10 @@
          [l (serialize-srcloc! s (syntax-srcloc d))]
          [r (serialize! s (syntax-props d))]
          [key `(8 ,(small e) ,(small sc) ,(small l) ,(small r))]
-         [i (shared-index s key)]
+         [known (shared-find s key)]
          [p (& (-> s out))])
-    (if (!= i 0)
-        (- i 1)
+    (if (!= known 0)
+        (@ known)
         (begin (buffer-add-byte! p 8) (write-uleb p e) (write-uleb p sc) (write-uleb p l) (write-uleb p r)
                (shared-added! s key)))))
 
@@ -162,10 +169,10 @@
       (serialize! s 0)
       (let* ([src (serialize! s (-> l source))]
              [key `(9 ,(small src) ,(small (-> l line)) ,(small (-> l col)) ,(small (-> l pos)) ,(small (-> l span)))]
-             [i (shared-index s key)]
+             [known (shared-find s key)]
              [p (& (-> s out))])
-        (if (!= i 0)
-            (- i 1)
+        (if (!= known 0)
+            (@ known)
             (begin (buffer-add-byte! p 9)
                    (write-uleb p src)
                    (write-sleb p (-> l line))

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 enum match exception throw try lambda inst typedef const let let* set!
+(provide define struct union variant enum match exception throw try lambda 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 @ & ->
@@ -12,12 +12,15 @@
          printf print-bytes
          output-to! test expect expect-equal test-failed test-skipped
          buffer-add-entries! entry-strings
+         error error-fail! error-text error-free! host-failed!
+         error-missing error-unreachable error-refused error-timeout error-invalid error-aborted error-denied
+         error-in-use error-other error-not-granted error-exists
          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 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!
+         buffer-reserve buffer-free! buffer-trim! hash-bytes hash-table hash-find hash-ref hash-set! hash-clear! hash-free!
          string-copy
          f64-bits bits-f64 f32-bits digit-value digits? digits-integer read-decimal decimal-flonum shortest-digits
          write-digits write-flonum write-string)
@@ -26,7 +29,7 @@
 
 (define-syntax forms (quote-syntax (#%form forms)))
 (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
+       throw try lambda 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 copy printf test expect expect-equal
        + - * / % == != < <= > >= and or not bit-and bit-or bit-xor bit-not << >>
        += -= *= /= %= <<= >>= bit-and= bit-or= bit-xor=)
@@ -86,10 +89,45 @@
 
 (func (reset-stack!) (set! sp (i32.add stack-base 4194304)))
 
+;; ---- errors ----
+;; A fallible function returns #t, or #f with an error as its last argument. Callers can pass a null pointer (0) when
+;; they do not need the error. They can do the same for an id the function creates. Error codes are defined here.
+
+(const error-missing i32 1)
+(const error-unreachable i32 2)
+(const error-refused i32 3)
+(const error-timeout i32 4)
+(const error-invalid i32 5)
+(const error-aborted i32 6)
+(const error-denied i32 7)
+(const error-in-use i32 8)
+(const error-other i32 9)
+(const error-not-granted i32 10)
+(const error-exists i32 11)
+
+(struct error [code i32] [message buffer])
+
+(define (error-fail! [e (ptr error)] [code i32] [why string]) -> bool
+  (when (!= e 0)
+    (set! (-> e code) code)
+    (set! (-> e message length) 0)
+    (buffer-add-string! (& (-> e message)) why))
+  #f)
+
+(define (error-text [e (ptr error)]) -> string (buffer-string (& (-> e message))))
+
+(define (error-free! [e (ptr error)]) (buffer-free! (& (-> e message))))
+
+(define (host-failed! [why (ptr string)] [e (ptr error)]) -> bool
+  (error-fail! e (failure_code) (@ why))
+  (free (-> why bytes))
+  #f)
+
 ;; ---- the host ----
 ;; Every program may call these host functions without a grant. A call that gives a string or bytes gives them in a
 ;; block from malloc for the caller to free; its pointer is 0 when there are none. A call that can fail stores the
-;; reason at err as such a string, unless err is 0. Lists are slices of strings.
+;; reason at err as such a string, unless err is 0. failure_code then gives the failure's code. Lists are slices of
+;; strings.
 
 (import write "host" "write" (i32 i32 i32 -> i32))
 (import trap "host" "trap" (i32 i32 ->))
@@ -101,6 +139,7 @@
 (import program_modules "host" "program_modules" (i32 -> i32))
 (import module_bytes "host" "module_bytes" (i32 i32 i32 -> i32))
 (import compiled_file "host" "compiled_file" (i32 i32 i32 -> i32))
+(import failure_code "host" "failure_code" (-> i32))
 
 (define (host-write [fd i32] [b (slice u8)]) #:inline -> i32 (write fd (cast i32 (-> b items)) (cast i32 (-> b length))))
 (define (host-trap [s string]) #:inline (trap (cast i32 (-> s bytes)) (cast i32 (-> s length))))
@@ -128,15 +167,15 @@
 ;; is a worker, in which case its parent gets the reason when the worker ends.
 (define (host-exit [code i32] [reason string]) #:inline
   (exit code (cast i32 (-> reason bytes)) (cast i32 (-> reason length))))
-(define (host-instantiate [name string] [code (slice u8)] [imports (slice string)] [compile-time bool] [err (ptr string)])
-  -> i32
-  (let ([b (make-buffer)] [r 0])
+(define (host-instantiate [name string] [code (slice u8)] [imports (slice string)] [compile-time bool]
+                          [err (ptr error)]) -> bool
+  (let ([b (make-buffer)] [r 0] [why string])
     (buffer-add-entries! (& b) imports)
     (set! r (instantiate (cast i32 (-> name bytes)) (cast i32 (-> name length)) (cast i32 (-> code items))
                          (cast i32 (-> code length)) (cast i32 (-> b bytes)) (cast i32 (-> b length)) compile-time
-                         (cast i32 err)))
+                         (cast i32 (& why))))
     (buffer-free! (& b))
-    r))
+    (or (== r 0) (host-failed! (& why) err))))
 (define (host-export-index [instance string] [field string]) #:inline -> i32
   (export_index (cast i32 (-> instance bytes)) (cast i32 (-> instance length)) (cast i32 (-> field bytes))
                 (cast i32 (-> field length))))
@@ -586,15 +625,18 @@
 
 (struct hash-table [keys (ptr u64)] [values (ptr u32)] [count u32] [capacity u32] [shift u32] [arena (ptr arena)])
 
-(define (hash-ref [t (ptr hash-table)] [key u64]) #:inline -> u32
+(define (hash-find [t (ptr hash-table)] [key u64]) #:inline -> (ptr u32)
   (if (== (-> t capacity) 0)
       0
       (let* ([keys (-> t keys)] [mask (- (-> t capacity) 1)] [i (cast u32 (>> (* key 11400714819323198485) (-> t shift)))])
         (while (!= (@ keys i) 0)
-          (when (== (@ keys i) key) (return (@ (-> t values) i)))
+          (when (== (@ keys i) key) (return (+ (-> t values) i)))
           (set! i (bit-and (+ i 1) mask)))
         0)))
 
+(define (hash-ref [t (ptr hash-table)] [key u64]) #:inline -> u32
+  (let ([p (hash-find t key)]) (if (== p 0) 0 (@ p))))
+
 (define (hash-set! [t (ptr hash-table)] [key u64] [value u32])
   (when (>= (* 2 (+ (-> t count) 1)) (-> t capacity)) (hash-grow t))
   (let* ([keys (-> t keys)] [mask (- (-> t capacity) 1)] [i (cast u32 (>> (* key 11400714819323198485) (-> t shift)))])

package/substrate/host/errors.mjs

@@ -1,7 +1,7 @@
-// The error codes of failed events (events.sub), and errorOf, which gives a JavaScript error its code.
+// The error codes (compiler/substrate.sub), and errorOf, which gives a JavaScript error its code.
 export const errors = {
   missing: 1, unreachable: 2, refused: 3, timeout: 4, invalid: 5, aborted: 6, denied: 7, inUse: 8, other: 9,
-  notGranted: 10,
+  notGranted: 10, exists: 11,
 };
 
 const unreachable = new Set(['ENOTFOUND', 'EAI_AGAIN', 'EHOSTUNREACH', 'ENETUNREACH']);
@@ -13,6 +13,7 @@ export function errorOf(e) {
   if (e.name === 'NotAllowedError' || e.name === 'SecurityError') return errors.denied;
   if (e.code === 'ENOENT' || e.code === 'ENOTDIR') return errors.missing;
   if (e.code === 'EACCES' || e.code === 'EPERM') return errors.denied;
+  if (e.code === 'EEXIST') return errors.exists;
   if (e.code === 'ECONNREFUSED') return errors.refused;
   if (e.code === 'EADDRINUSE') return errors.inUse;
   if (e.code === 'ECONNRESET' || e.code === 'EPIPE') return errors.aborted;