substrate-lang 0.9.2 → 0.9.4

package/substrate/compiler/expander.sub

@@ -11,18 +11,19 @@
 (require-unqualified "checker.sub")
 (require-unqualified "link.sub")
 (require-unqualified "roots.sub")
+(require-unqualified "sha256.sub")
 
 (provide install-core!
          compile-module-file
          expand-module-file
-         content-hash wasm-module program-wasm-modules trap-report
+         wasm-module program-wasm-modules program-compiled-modules trap-report
          set-cache-directory!
-         session-open! session-eval! session-eval-text! session-eval-file! session-error session-recover!)
+         session-open! session-eval! session-eval-text! session-eval-file! session-error)
 
 (define core-forms datum
   '(func global import supply memory table tag define-syntax begin-for-syntax
-           begin require require-unqualified language provide set! let let* if block loop br br-if br-table
-           return
+           begin require require-unqualified runtime-require language provide set! let let* if block loop br br-if
+           br-table return
            call-indirect func-index select drop values unreachable nop
            throw throw-ref try
            i32.const i64.const f32.const f64.const
@@ -30,7 +31,7 @@
            #%app #%datum #%fact #%checked))
 
 (define visible-core-forms datum
-  '(define-syntax begin-for-syntax begin require require-unqualified language provide
+  '(define-syntax begin-for-syntax begin require require-unqualified runtime-require language provide
            quote quote-syntax include-text #%app #%datum #%fact))
 
 (define wasm-forms datum
@@ -72,19 +73,21 @@
 (define scope-counter u32 2)
 (define registry hash-table)
 (define units-by-hash hash-table)
+(define units-by-name hash-table)
 
 (struct wasm-module [phase i32] [bytes datum] [imports datum] [scopes datum] [next (ptr wasm-module)])
 
 (struct unit [self datum] [path datum] [name datum] [hash datum] [state datum] [requires datum] [provides datum]
         [entries (ptr module-entry)] [code datum] [scope u32] [infos datum] [facts datum]
-        [wasm-modules (ptr wasm-module)] [scope-count u32] [memories datum] [resolved datum] [included datum])
+        [wasm-modules (ptr wasm-module)] [scope-count u32] [memories datum] [resolved datum] [included datum]
+        [runtime-requires datum])
 
 (struct module-entry [symbol datum] [scopes (ptr scope-set)] [phase i32] [binding (ptr binding)] [next (ptr module-entry)])
 
 (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))
@@ -102,6 +105,7 @@
     (set! (-> m scope-count) 0)
     (set! (-> m resolved) nil)
     (set! (-> m included) nil)
+    (set! (-> m runtime-requires) nil)
     (-> m self)))
 
 (define (unit-of [m datum]) -> (ptr unit) (cast (ptr unit) (record-pointer m)))
@@ -118,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)
@@ -224,16 +228,14 @@
     out))
 
 (define (group-instance [name datum]) -> datum
-  (let* ([b (datum->string name)] [n (-> b length)] [i u32 0] [dot u32 0] [l running-group] [m datum 0])
+  (let* ([b (datum->string name)] [n (-> b length)] [i u32 0] [l running-group] [m datum 0])
     (while (and (< i n) (!= (@ b i) #\@)) (+= i 1))
     (unless (and (< (+ i 2) n) (== (@ b (+ i 1)) #\0) (== (@ b (+ i 2)) #\+)) (return 0))
     (while (pair? l)
       (let ([g (datum->string (car l))])
         (when (and (== (-> g length) (+ i 4)) (== (slice g 0 (+ i 1)) (slice b 0 (+ i 1)))) (return (car l))))
       (set! l (cdr l)))
-    (while (and (< dot i) (!= (@ b dot) #\.)) (+= dot 1))
-    (when (>= dot i) (return 0))
-    (set! m (cast datum (hash-ref (& units-by-hash) (cast u64 (string->symbol (slice b (+ dot 1) i))))))
+    (set! m (cast datum (hash-ref (& units-by-name) (cast u64 (string->symbol (slice b 0 i))))))
     (if (== m 0) 0 (agreeing-instance name m))))
 
 (define agreements hash-table)
@@ -262,7 +264,9 @@
 ;; Keeps macros.sub in the compiler's program.
 (define macro-tools (fn (datum datum) -> datum) syntax-match-expansion)
 
+;; install-core! sets up the compiler in the running program. Calling it again does nothing.
 (define (install-core!)
+  (unless (== running-syntax 0) (return))
   (for-each (lambda ([name datum])
               (bind-raw! name (if (memq name visible-core-forms) visible-scopes wasm-scopes) all-phases `(core ,name)))
             core-forms)
@@ -275,7 +279,7 @@
   (let* ([names (running-module-names)] [name (running-module-named names "syntax.")] [tools (running-module-named names "macros.")])
     (when (== name 0) (fail-at 0 "the running program has no syntax module" nil))
     (set! running-names (keep names))
-    (set! compiler-hash (keep (content-hash (compiler-names names))))
+    (set! compiler-hash (keep (digest (compiler-names names))))
     (set! syntax-instance (keep name))
     (set! running-group (keep (group-of (if (!= tools 0) tools name))))
     (set! running-syntax (running-unit name '"syntax"))
@@ -349,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)
@@ -582,18 +583,28 @@
     (buffer-free! (& out))
     s))
 
-(define (content-hash [ss datum]) -> datum
-  (let ([h u64 14695981039346656037] [digits (array u8 12)])
+;; digest is the SHA-256, in hex, of a list of strings, each preceded by its length.
+(define (digest [ss datum]) -> datum
+  (let ([s sha256] [n (array u8 8)] [out (array u8 32)])
+    (sha256-init! (& s))
     (while (pair? ss)
-      (let* ([s (datum->string (car ss))] [p (-> s bytes)])
-        (for ([i u32 0]) (< i (-> s length)) (+= i 1)
-          (set! h (* (bit-xor h (@ p i)) 1099511628211))))
-      (set! h (* h 1099511628211))
+      (let ([b (cast (slice u8) (datum->string (car ss)))])
+        (for ([i u32 0]) (< i 8) (+= i 1) (set! (@ n i) (cast u8 (>> (cast u64 (-> b length)) (* 8 i)))))
+        (sha256-add! (& s) (slice n))
+        (sha256-add! (& s) b))
       (set! ss (cdr ss)))
-    (for ([k 0]) (< k 12) (+= k 1)
-      (let ([d (cast i32 (bit-and (>> h (- 60 (* k 4))) 15))])
-        (set! (@ digits k) (if (< d 10) (+ 48 d) (+ 87 d)))))
-    (string->datum (cast string (slice digits)))))
+    (sha256-end! (& s) (slice out))
+    (hex-of (slice out))))
+
+(define (bytes-digest [b (slice u8)]) -> datum
+  (let ([out (array u8 32)]) (sha256-of b (slice out)) (hex-of (slice out))))
+
+(define (hex-of [b (slice u8)]) -> datum
+  (let ([hex (array u8 64)])
+    (for ([i u32 0]) (< i 64) (+= i 1)
+      (let* ([x (cast i32 (@ b (/ i 2)))] [d (if (== (% i 2) 0) (>> x 4) (bit-and x 15))])
+        (set! (@ hex i) (if (< d 10) (+ 48 d) (+ 87 d)))))
+    (string->datum (cast string (slice hex)))))
 
 (define (module-hash [path datum] [text datum] [requires datum] [included datum]) -> datum
   (let ([parts (if (root-under-test? (identity-label path)) `(,path ,text "test") `(,path ,text))])
@@ -604,7 +615,12 @@
     (while (pair? included)
       (set! parts (append parts `(,(car (car included)) ,(cdr (car included)))))
       (set! included (cdr included)))
-    (content-hash parts)))
+    (digest parts)))
+
+;; A module's name is its file name without the extension, a dot, and the first 12 digits of its hash, as in
+;; counter.f745d27a5fbc.
+(define (module-name [path datum] [hash datum]) -> datum
+  (format "~a.~a" `(,(file-stem path) ,(substring hash 0 12))))
 
 (define (source-text [id datum]) -> datum (file-text (host-file id)))
 
@@ -623,6 +639,11 @@
     (cond [(and (!= known 0) (== (-> (unit-of known) state) 'done)) known]
           [(!= known 0) (fail-at 0 "cyclic require: ~a requires itself" (list1 path))]
           [(begin (set! cached (load-cached path)) (!= cached 0)) cached]
+          [(compiled-root? path)
+           (fail-at where (if (== (compiled-module path) 0)
+                              "~a is not available to this program's sessions; list it in runtime-require"
+                              "the program's compiled ~a is inconsistent with its other compiled modules")
+                    (list1 path))]
           [(wasm-file? path) (wasm-file-unit path key)]
           [else
            (let* ([text (source-text path)] [m (new-unit path (provisional-name path))] [saved current])
@@ -661,7 +682,7 @@
     (set! (-> u requires) (keep (list1 (cons prelude (make-integer 0)))))
     (set! (-> u hash) (keep (module-hash path (string->datum (cast string (datum->bytes bytes)))
                                          (list1 `(,(-> (unit-of prelude) hash) ,(make-integer 0))) nil)))
-    (set! (-> u name) (keep (format "~a.~a" `(,(file-stem path) ,(-> u hash)))))
+    (set! (-> u name) (keep (module-name path (-> u hash))))
     (note-hash! m)
     (set! instance (wasm-module-name m 0 0))
     (set! linked (link-side-module path bytes (wasm-module-name prelude 0 0)))
@@ -760,7 +781,7 @@
                                          (map (lambda ([r datum]) -> datum `(,(-> (unit-of (car r)) hash) ,(cdr r)))
                                               (-> m requires))
                                          (-> m included))))
-    (set! (-> m name) (keep (format "~a.~a" `(,(file-stem (-> m path)) ,(-> m hash)))))
+    (set! (-> m name) (keep (module-name (-> m path) (-> m hash))))
     (note-hash! (-> m self))
     (compile-wasm-modules!)))
 
@@ -791,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)))
@@ -850,7 +871,7 @@
     (for-each (lambda ([p datum])
                 (let* ([meaning (cdr p)] [base (definition-of meaning)]
                        [d (if (and (!= base 0) (== (definition-module base) m)) (meaning-description meaning) 0)])
-                  (when (!= d 0) (set! out (cons (cons (car p) (content-hash (list1 (format "~s" (list1 d))))) out)))))
+                  (when (!= d 0) (set! out (cons (cons (car p) (digest (list1 (format "~s" (list1 d))))) out)))))
               (-> (unit-of m) provides))
     (reverse out)))
 
@@ -906,6 +927,29 @@
     (set! out (visit-wasm-modules m seen out))
     (reverse out)))
 
+;; program-compiled-modules returns the compiled modules that the program's sessions can load: those named in
+;; runtime-require forms, and everything they require. Each is (identity hash bytes), where bytes is the module's cache
+;; entry and hash is the SHA-256 of bytes.
+(define (program-compiled-modules [m datum]) -> datum
+  (let ([todo nil] [seen nil] [out nil])
+    (for-each (lambda ([l datum])
+                (let ([u (instance-unit (car l))])
+                  (unless (== u 0) (set! todo (append (-> (unit-of u) runtime-requires) todo)))))
+              (program-wasm-modules m))
+    (while (pair? todo)
+      (let ([id (car todo)])
+        (set! todo (cdr todo))
+        (when (== (member id seen) 0)
+          (let ([u (unit-of (module-at id 0))] [b (make-buffer)] [bytes datum 0])
+            (set! seen (cons id seen))
+            (sealed! (& b) (list1 (cache-form (-> u self))))
+            (set! bytes (bytes->datum (buffer-bytes (& b))))
+            (buffer-free! (& b))
+            (set! out (cons `(,id ,(bytes-digest (datum->bytes bytes)) ,bytes) out))
+            (set! todo (append (map (lambda ([r datum]) -> datum (-> (unit-of (car r)) path)) (-> u requires))
+                               (append (-> u runtime-requires) todo)))))))
+    (reverse out)))
+
 (define (visit-wasm-modules [m datum] [seen (ptr hash-table)] [out datum]) -> datum
   (let ([name (wasm-module-name m 0 0)] [l nil])
     (when (!= (datum-get seen name) 0) (return out))
@@ -971,7 +1015,7 @@
 (define cache-directory datum 0)
 (define (set-cache-directory! [dir datum]) (set! cache-directory (keep dir)))
 
-(const cache-format i64 7)
+(const cache-format i64 8)
 
 (define compiler-hash datum 0)
 
@@ -990,18 +1034,17 @@
 
 (define (sealed? [s (slice u8)]) -> bool
   (let ([n (-> s length)])
-    (and (>= n 8) (== (@ (cast (ptr u64) (+ (-> s items) (- n 8))) 0) (data-hash (slice (-> s items) (- n 8)))))))
+    (and (>= n 8) (== (@ (cast (ptr u64) (+ (-> s items) (- n 8))) 0) (hash-bytes (slice (-> s items) (- n 8)))))))
 
-(define (data-hash [s (slice u8)]) -> u64
-  (let ([h u64 14695981039346656037] [p (-> s items)])
-    (for ([i u32 0]) (< i (-> s length)) (+= i 1)
-      (set! h (* (bit-xor h (@ p i)) 1099511628211)))
-    h))
+;; sealed! writes d to b, followed by a checksum that read-data verifies.
+(define (sealed! [b (ptr buffer)] [d datum])
+  (let* ([data (datum->bytes (data-bytes d))] [h (hash-bytes data)])
+    (buffer-add! b data)
+    (for ([i u64 0]) (< i 64) (+= i 8) (buffer-add-byte! b (cast i32 (bit-and (>> h i) 255))))))
 
 (define (write-data [path datum] [d datum]) -> bool
-  (let* ([data (datum->bytes (data-bytes d))] [h (data-hash data)] [b (make-buffer)] [temp string] [ok #f])
-    (buffer-add! (& b) data)
-    (for ([i u64 0]) (< i 64) (+= i 8) (buffer-add-byte! (& b) (cast i32 (bit-and (>> h i) 255))))
+  (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)))
       (unless ok (fs-remove temp #f 0))
@@ -1028,8 +1071,10 @@
        (equal? (section d 'format) (make-integer cache-format))
        (equal? (section d 'compiler) compiler-hash)))
 
+;; load-cached loads a module from the cache, or from the program's compiled modules if that is where the module comes
+;; from.
 (define (load-cached [path datum]) -> datum
-  (if (== (cache-compiler) 0)
+  (if (if (compiled-root? path) (== (compiled-module path) 0) (== (cache-compiler) 0))
       0
       (begin
         (begin-module-arena)
@@ -1038,20 +1083,25 @@
           m))))
 
 (define (load-cached-in [path datum]) -> datum
-  (let* ([ds (read-data (cache-file (cache-name path)))]
+  (let* ([shipped (compiled-module path)]
+         [ds (if (!= shipped 0) (compiled-data (cadr shipped)) (read-data (cache-file (cache-name path))))]
          [d (if (pair? ds) (car ds) 0)]
          [key (cast u64 (symbol-of path))]
          [hash datum 0] [requires datum 0] [included datum 0] [known datum 0] [m datum 0])
+    (when (and (!= shipped 0) (== d 0)) (fail-at 0 "the program's compiled ~a is missing or damaged" (list1 path)))
+    (when (and (!= shipped 0) (not (current-cache? d)))
+      (fail-at 0 "the program's compiled modules were built by a different compiler" nil))
     (unless (current-cache? d) (return 0))
     (set! hash (section d 'hash))
     (set! requires (section d 'requires))
-    (set! included (included-again (section d 'included)))
-    (unless (and (string? hash) (!= included 0)
-                 (equal? (module-hash path (source-text path)
-                                      (map (lambda ([r datum]) -> datum (cdr r)) requires)
-                                      included)
-                         hash))
-      (return 0))
+    (unless (string? hash) (return 0))
+    (when (== shipped 0)
+      (set! included (included-again (section d 'included)))
+      (unless (and (!= included 0)
+                   (equal? (module-hash path (source-text path) (map (lambda ([r datum]) -> datum (cdr r)) requires)
+                                        included)
+                           hash))
+        (return 0)))
     (unless (resolved-again? (section d 'resolved)) (return 0))
     (hash-set! (& registry) key (cast u32 (new-unit path path)))
     (while (pair? requires)
@@ -1093,13 +1143,17 @@
 
 (define (cache-name [path datum]) -> datum
   (let ([file (host-file path)])
-    (concat (content-hash (if (root-under-test? (identity-label path)) `(,file "test") (list1 file))) '".subc")))
+    (concat (digest (if (root-under-test? (identity-label path)) `(,file "test") (list1 file))) '".subc")))
 
 (define (note-hash! [m datum])
-  (let* ([u (unit-of m)] [key (cast u64 (symbol-of (-> u hash)))] [known (cast datum (hash-ref (& units-by-hash) key))])
+  (let* ([u (unit-of m)] [key (cast u64 (symbol-of (-> u hash)))] [known (cast datum (hash-ref (& units-by-hash) key))]
+         [name-key (cast u64 (symbol-of (-> u name)))] [named (cast datum (hash-ref (& units-by-name) name-key))])
     (cond [(== known 0) (hash-set! (& units-by-hash) key (cast u32 m))]
           [(not (equal? (-> (unit-of known) path) (-> u path)))
-           (fail-at 0 "~a and ~a have the same hash, ~a" `(,(-> (unit-of known) path) ,(-> u path) ,(-> u hash)))])))
+           (fail-at 0 "~a and ~a have the same hash, ~a" `(,(-> (unit-of known) path) ,(-> u path) ,(-> u hash)))])
+    (cond [(== named 0) (hash-set! (& units-by-name) name-key (cast u32 m))]
+          [(not (equal? (-> (unit-of named) path) (-> u path)))
+           (fail-at 0 "~a and ~a have the same name, ~a" `(,(-> (unit-of named) path) ,(-> u path) ,(-> u name)))])))
 
 (define (load-compiled-module [d datum] [path datum]) -> datum
   (let ([m (new-unit path (section d 'name))])
@@ -1216,6 +1270,7 @@
       `((format . ,(make-integer cache-format)) (compiler . ,compiler-hash) (hash . ,(-> u hash))
         (definitions . ,(make-integer (length (-> u infos)))) (requires . ,require-forms) (resolved . ,(-> u resolved))
         (included . ,(map (lambda ([i datum]) -> datum (car i)) (-> u included))) (name . ,(-> u name))
+        (runtime-requires . ,(-> u runtime-requires))
         (infos . ,infos) (provides . ,provides) (entries . ,entries)
         (inlines . ,inline-forms) (macros . ,macro-forms) (facts . ,fact-forms) (wasm-modules . ,wasm-modules)
         (memories . ,(-> u memories))))))
@@ -1333,17 +1388,17 @@
 (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)]
          [definitions (cast u32 (integer-value (section d 'definitions)))])
     (set! (-> u name) (keep (section d 'name)))
     (set! (-> u hash) (keep (section d 'hash)))
-    (hash-set! (& units-by-hash) (cast u64 (symbol-of (-> u hash))) (cast u32 m))
+    (set! (-> u resolved) (keep (section d 'resolved)))
+    (set! (-> u included) (keep (map (lambda ([i datum]) -> datum (cons i 0)) (section d 'included))))
+    (set! (-> u runtime-requires) (keep (section d 'runtime-requires)))
+    (note-hash! m)
     (set! (-> u scope) (new-run-scope!))
     (hash-set! (& module-scope-origins) (scope-key (-> u scope)) (cast u32 (keep (cons m (make-integer 0)))))
     (set! loading m)
@@ -1362,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)
@@ -1459,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)
@@ -1491,7 +1546,9 @@
 (define (declare-form! [f0 datum] [b (ptr body)] [only datum])
   (let* ([phase (-> b phase)] [f (head-expand f0 phase)] [kind (core-head f phase)])
     (when (and (!= only 0)
-               (!= (memq kind '(require require-unqualified language provide memory table define-syntax begin-for-syntax)) 0))
+               (!= (memq kind '(require require-unqualified runtime-require language provide memory table define-syntax
+                                begin-for-syntax))
+                   0))
       (fail-at f "~a (~a ...), but only func, global, import, tag, data and #%fact forms and expressions are allowed there"
                `(,only ,kind)))
     (case kind
@@ -1500,6 +1557,7 @@
          (for-each (lambda ([g datum]) (declare-form! (at-use f g) b only)) forms))]
       [('require) (require! f phase 0)]
       [('require-unqualified) (require! f phase 1)]
+      [('runtime-require) (runtime-require! f phase)]
       [('language) (if (in-session?) (require! f phase 2) (fail-at f "the language must be the module's first form" nil))]
       [('provide) (provide! f phase)]
       [('func) (item! b (declare-func f phase))]
@@ -1782,6 +1840,21 @@
   (let ([me (the-module)] [r `(,(if (== from 0) '#f from) ,given ,path)])
     (when (== (member r (-> me resolved)) 0) (set! (-> me resolved) (keep (append (-> me resolved) (list1 r)))))))
 
+;; (runtime-require source ...) lists modules that the program's sessions can load. They are resolved and checked the
+;; same way as in require, and building the program also compiles them and writes them to the output.
+(define (runtime-require! [f datum] [phase i32])
+  (let ([l (syntax->list f)] [me (the-module)])
+    (unless (and (!= l 0) (andmap (lambda ([s datum]) -> bool (module-source? s)) (cdr l)))
+      (no-match f "(runtime-require source ...)"))
+    (when (or (!= phase 0) (in-session?)) (fail-at f "runtime-require belongs at phase 0 of a module" nil))
+    (for-each (lambda ([spec datum])
+                (let* ([from (module-source-file f spec)] [path (module-path-from from spec)])
+                  (note-resolved! from (syntax-e spec) path)
+                  (check-module! (-> me path) path spec)
+                  (when (== (member path (-> me runtime-requires)) 0)
+                    (set! (-> me runtime-requires) (keep (append (-> me runtime-requires) (list1 path)))))))
+              (cdr l))))
+
 ;; (include-text "file") is the file's text as a string literal. Its path is resolved as a require's is, and the
 ;; module's hash covers the file.
 (define (included-text [s datum]) -> datum
@@ -1799,7 +1872,7 @@
         (set! (-> me included) (keep (append (-> me included) (list1 (cons id (text-hash text)))))))
       (datum->syntax spec text spec))))
 
-(define (text-hash [text datum]) -> datum (content-hash (list1 text)))
+(define (text-hash [text datum]) -> datum (digest (list1 text)))
 
 (define (require-unit! [name datum] [m datum] [phase i32]) -> datum
   (let ([me (the-module)] [req (cons m (make-integer phase))])
@@ -1902,8 +1975,13 @@
 
 (define (ns-name [name datum]) -> datum (format "~a/~a" `(,(-> current ns) ,name)))
 
+;; instance-name returns the instance a module's code links to: the running program's own instance if the program
+;; contains the module, which only happens for session code, and otherwise this namespace's instance.
+(define (instance-name [name datum]) -> datum (if (running-wasm-module? name) name (ns-name name)))
+
 (define (namespaced? [name datum]) -> bool
-  (and (== (group-instance name) 0) (!= (hash-ref (& instance-refs) (cast u64 (symbol-of name))) 0)))
+  (and (== (group-instance name) 0) (not (running-wasm-module? name))
+       (!= (hash-ref (& instance-refs) (cast u64 (symbol-of name))) 0)))
 
 (define (integer-at [l datum] [n u32]) -> i32 (cast i32 (integer-value (list-ref l n))))
 
@@ -1915,7 +1993,8 @@
       (cond [(!= g 0) (set! out (cons (cons (car imports) g) out))]
             [(== r 0) 0]
             [(pair? (cddr r))
-             (set! out (cons (cons (car imports) (ns-name (wasm-module-name (car r) (integer-at r 1) (+ (integer-at r 2) (cast i32 t))))) out))]
+             (set! out (cons (cons (car imports) (instance-name (wasm-module-name (car r) (integer-at r 1) (+ (integer-at r 2) (cast i32 t)))))
+                             out))]
             [else (set! out (cons (cons (car imports) (ns-name (car imports))) out))])
       (set! imports (cdr imports)))
     out))
@@ -1925,9 +2004,9 @@
     (when (!= r 0) (ensure-wasm-module! (car r) (integer-at r 1) (+ (cast u32 (integer-at r 2)) shift)))))
 
 (define (ensure-wasm-module! [m datum] [q i32] [t u32])
-  (let* ([name (ns-name (wasm-module-name m q (cast i32 t)))] [key (cast u64 (symbol-of name))] [p (ptr wasm-module) 0]
-         [l nil])
-    (when (== (hash-ref (-> current instances) key) 0)
+  (let* ([plain (wasm-module-name m q (cast i32 t))] [name (ns-name plain)] [key (cast u64 (symbol-of name))]
+         [p (ptr wasm-module) 0] [l nil])
+    (when (and (not (running-wasm-module? plain)) (== (hash-ref (-> current instances) key) 0))
       (set! p (wasm-module-of m q))
       (when (== p 0) (fail-at 0 "internal: ~a has no phase ~a wasm module" `(,(-> (unit-of m) name) ,(make-integer q))))
       (set! l (suppliers-of m))
@@ -1943,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))
@@ -2336,13 +2413,51 @@
 (define session-source datum 0)
 (define session-message datum 0)
 (define session-running bool #f)
+(define session-evaluating bool #f)
 (define interacting bool #f)
 
 (define (in-session?) -> bool (and (!= session 0) (== current session)))
 
+;; use-compiled-modules! makes sessions load the compiled modules that the program's build wrote, if there are any,
+;; using the module map they were built with.
+(define (use-compiled-modules!)
+  (let ([listed (compiled-listed (compiled-text '"compiled"))])
+    (unless (null? listed)
+      (set-compiled-module-map! (map (lambda ([f datum]) -> datum (syntax->datum f))
+                                     (read-text (compiled-text '"compiled.map") (symbol-of '"compiled.map")))
+                                listed))))
+
+;; compiled-listed reads the compiled file, which has one module per line: its hash, a space, and its identity.
+(define (compiled-listed [text datum]) -> datum
+  (let ([s (datum->string text)] [start u32 0] [out nil])
+    (for ([i u32 0]) (<= i (-> s length)) (+= i 1)
+      (when (or (== i (-> s length)) (== (@ s i) 10))
+        (let ([space start])
+          (while (and (< space i) (!= (@ s space) 32)) (+= space 1))
+          (when (< space i)
+            (set! out (cons `(,(string->datum (slice s (+ space 1) i)) ,(string->datum (slice s start space))) out))))
+        (set! start (+ i 1))))
+    (reverse out)))
+
+(define (compiled-bytes [name datum]) -> datum
+  (let ([b (host-compiled-file (datum->string name))] [d datum 0])
+    (when (> (-> b length) 0) (set! d (bytes->datum b)))
+    (free (-> b items))
+    d))
+
+(define (compiled-text [name datum]) -> datum
+  (let ([d (compiled-bytes name)]) (if (== d 0) '"" (string->datum (cast string (datum->bytes d))))))
+
+(define (compiled-data [hash datum]) -> datum
+  (let ([d (compiled-bytes (concat hash '".subc"))])
+    (if (and (!= d 0) (equal? (bytes-digest (datum->bytes d)) hash)) (data-of d) 0)))
+
 (define (module-source) -> datum (if (in-session?) session-source (symbol-of (-> (the-module) path))))
 
+;; session-open! opens the program's single session, which starts out in Substrate. name is used in error messages.
 (define (session-open! [name datum])
+  (install-core!)
+  (use-compiled-modules!)
   (let ([m (new-unit (identity 0 name) (provisional-name name))])
     (begin-module-arena)
     (set! session-mark (module-arena-mark))
@@ -2386,7 +2501,10 @@
       (set! e (-> e next)))
     (set! (-> (the-module) entries) entries)))
 
+;; session-eval! compiles and runs forms in the session, and returns #f if they fail.
 (define (session-eval! [forms datum]) -> bool
+  (when session-evaluating (session-recover!))
+  (set! session-evaluating #t)
   (let* ([sc (new-scope!)] [scopes (scopes-change session-set sc 0)] [entries (-> (the-module) entries)] [ok #f]
          [was comp (@ session)])
     (set! session-scope sc)
@@ -2407,8 +2525,10 @@
           (set! (@ session) was)
           (set! (-> session wasm-module-counter) n)))
     (set! session-scope 0)
+    (set! session-evaluating #f)
     ok))
 
+;; session-eval-text! reads forms from text and evaluates them. Error messages refer to the text as source.
 (define (session-eval-text! [text datum] [source datum]) -> bool
   (let ([forms datum 0] [ok #f])
     (try
@@ -2417,6 +2537,7 @@
       [catch compile-error (message blamed loc) (session-fail! message blamed loc)])
     (and ok (session-eval! forms))))
 
+;; session-eval-file! evaluates a file's forms one at a time, and calls report with the message of each one that fails.
 (define (session-eval-file! [root datum] [source datum] [report (closure (datum))])
   (let ([path (program-identity root source)] [forms datum 0])
     (check-module! 0 path 0)
@@ -2425,6 +2546,7 @@
       (unless (session-eval! (list1 (car forms))) (report (session-error)))
       (set! forms (cdr forms)))))
 
+;; session-error returns the message of the last failure.
 (define (session-error) -> datum session-message)
 
 (define (run-session-wasm-module! [forms datum])
@@ -2449,7 +2571,9 @@
     (set! session-message (string->datum (buffer-string (& b))))
     (buffer-free! (& b))))
 
+;; session-recover! resets the compiler after an evaluation fails or traps.
 (define (session-recover!)
+  (set! session-evaluating #f)
   (end-module-arenas-to! session-mark)
   (while (pair? compiling)
     (hash-set! (& registry) (cast u64 (car compiling)) 0)
@@ -2749,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)