substrate-lang 0.10.0 → 0.10.2

package/std/web/gpu.sub

@@ -1,429 +1,22 @@
-;; WebGPU from a program: the program's side of the host module "gpu".
+;; WebGPU from a program: the commands of gpu-commands.sub, sent to the host module "gpu" (host/web/gpu.sub) in
+;; batches. gpu-begin! starts a batch with the tag that its events go to, and gpu-send! sends it. The commands must be
+;; sent, or dropped with gpu-commands-done!, before the next batch begins.
 (require-unqualified host-gpu host/web/gpu)
+(require-unqualified commands "gpu-commands.sub")
 
-(provide (all-from-out host-gpu)
-         gpu-surface! gpu-shader! gpu-render-pipeline! gpu-layout-item! gpu-target! gpu-vertex-buffer-layout! gpu-attribute!
-         gpu-compute-pipeline! gpu-buffer! gpu-texture! gpu-texture-file! gpu-sampler! gpu-layout! gpu-layout-entry!
-         gpu-bind-group! gpu-bind-buffer! gpu-bind-sampler! gpu-bind-texture! gpu-destroy!
-         gpu-write-buffer! gpu-write-texture! gpu-read-texture! gpu-read-buffer!
-         gpu-render-pass! gpu-pass-target! gpu-compute-pass! gpu-end-pass! gpu-pipeline! gpu-bind-group-set! gpu-offset!
-         gpu-vertex-buffer! gpu-index-buffer! gpu-draw! gpu-draw-indexed! gpu-dispatch! gpu-viewport! gpu-scissor!
-         gpu-commands gpu-commands-done! gpu-frame-alloc gpu-frame-copy
-         gpu-format-surface gpu-rgba8 gpu-bgra8 gpu-r8 gpu-rg8 gpu-rgba16f gpu-r32f gpu-rgba32f gpu-depth24 gpu-depth32f
-         gpu-f32 gpu-f32x2 gpu-f32x3 gpu-f32x4 gpu-u32 gpu-u32x2 gpu-u32x4 gpu-i32 gpu-unorm8x4 gpu-snorm8x4
-         gpu-f16x2 gpu-f16x4 gpu-u8x4 gpu-unorm16x2 gpu-unorm16x4
-         gpu-triangles gpu-triangle-strip gpu-lines gpu-line-strip gpu-points
-         gpu-cull-none gpu-cull-back gpu-cull-front gpu-ccw gpu-cw
-         gpu-blend-none gpu-blend-alpha gpu-blend-premultiplied gpu-blend-add
-         gpu-compare-none gpu-less gpu-less-equal gpu-greater gpu-greater-equal gpu-equal gpu-always gpu-never
-         gpu-vertex gpu-index gpu-uniform gpu-storage gpu-indirect gpu-sampled gpu-target gpu-storage-texture
-         gpu-nearest gpu-linear gpu-clamp gpu-repeat gpu-mirror
-         gpu-uniform-entry gpu-storage-entry gpu-read-only-entry gpu-dynamic-uniform-entry gpu-dynamic-storage-entry
-         gpu-dynamic-read-only-entry gpu-sampler-entry gpu-comparison-entry gpu-texture-entry gpu-depth-entry
-         gpu-storage-texture-entry gpu-texture-array-entry gpu-depth-array-entry gpu-in-vertex gpu-in-fragment gpu-in-compute
-         gpu-per-vertex gpu-per-instance gpu-on-surface gpu-on-texture gpu-keep gpu-clear gpu-u16-indexes gpu-u32-indexes
-         gpu-kind-surface gpu-kind-shader gpu-kind-pipeline gpu-kind-buffer gpu-kind-texture gpu-kind-sampler
-         gpu-kind-layout gpu-kind-bind-group)
+(provide (all-from-out host-gpu) (all-from-out commands) gpu-begin! gpu-send!)
 
-;; ---- the codes ----
+(define batch-tag (ptr void) 0)
+(define batch-begun bool #f)
 
-;; Each code is the number host/web/gpu.mjs gives it.
-(const gpu-format-surface u32 0)
-(const gpu-rgba8 u32 1)
-(const gpu-bgra8 u32 2)
-(const gpu-r8 u32 3)
-(const gpu-rg8 u32 4)
-(const gpu-rgba16f u32 5)
-(const gpu-r32f u32 6)
-(const gpu-rgba32f u32 7)
-(const gpu-depth24 u32 8)
-(const gpu-depth32f u32 9)
+(define (gpu-begin! [tag (ptr void)])
+  (when (> (-> (gpu-commands) length) 0) (host-trap "gpu: a batch began while commands were waiting to be sent"))
+  (set! batch-tag tag)
+  (set! batch-begun #t))
 
-(const gpu-f32 u32 1)
-(const gpu-f32x2 u32 2)
-(const gpu-f32x3 u32 3)
-(const gpu-f32x4 u32 4)
-(const gpu-u32 u32 5)
-(const gpu-u32x2 u32 6)
-(const gpu-u32x4 u32 7)
-(const gpu-i32 u32 8)
-(const gpu-unorm8x4 u32 9)
-(const gpu-snorm8x4 u32 10)
-(const gpu-f16x2 u32 11)
-(const gpu-f16x4 u32 12)
-(const gpu-u8x4 u32 13)
-(const gpu-unorm16x2 u32 14)
-(const gpu-unorm16x4 u32 15)
-
-(const gpu-triangles u32 1)
-(const gpu-triangle-strip u32 2)
-(const gpu-lines u32 3)
-(const gpu-line-strip u32 4)
-(const gpu-points u32 5)
-
-(const gpu-cull-none u32 0)
-(const gpu-cull-back u32 1)
-(const gpu-cull-front u32 2)
-(const gpu-ccw u32 0)
-(const gpu-cw u32 1)
-
-(const gpu-blend-none u32 0)
-(const gpu-blend-alpha u32 1)
-(const gpu-blend-premultiplied u32 2)
-(const gpu-blend-add u32 3)
-
-(const gpu-compare-none u32 0)
-(const gpu-less u32 1)
-(const gpu-less-equal u32 2)
-(const gpu-greater u32 3)
-(const gpu-greater-equal u32 4)
-(const gpu-equal u32 5)
-(const gpu-always u32 6)
-(const gpu-never u32 7)
-
-(const gpu-vertex u32 1)
-(const gpu-index u32 2)
-(const gpu-uniform u32 4)
-(const gpu-storage u32 8)
-(const gpu-indirect u32 16)
-(const gpu-sampled u32 1)
-(const gpu-target u32 2)
-(const gpu-storage-texture u32 4)
-
-(const gpu-nearest u32 0)
-(const gpu-linear u32 1)
-(const gpu-clamp u32 0)
-(const gpu-repeat u32 1)
-(const gpu-mirror u32 2)
-
-(const gpu-uniform-entry u32 1)
-(const gpu-storage-entry u32 2)
-(const gpu-read-only-entry u32 3)
-(const gpu-dynamic-uniform-entry u32 4)
-(const gpu-dynamic-storage-entry u32 5)
-(const gpu-dynamic-read-only-entry u32 6)
-(const gpu-sampler-entry u32 7)
-(const gpu-comparison-entry u32 8)
-(const gpu-texture-entry u32 9)
-(const gpu-depth-entry u32 10)
-(const gpu-storage-texture-entry u32 11)
-(const gpu-texture-array-entry u32 12)
-(const gpu-depth-array-entry u32 13)
-(const gpu-in-vertex u32 1)
-(const gpu-in-fragment u32 2)
-(const gpu-in-compute u32 4)
-
-(const gpu-per-vertex u32 0)
-(const gpu-per-instance u32 1)
-(const gpu-on-surface u32 1)
-(const gpu-on-texture u32 2)
-(const gpu-keep u32 0)
-(const gpu-clear u32 1)
-(const gpu-u16-indexes u32 0)
-(const gpu-u32-indexes u32 1)
-
-(const gpu-kind-surface u32 1)
-(const gpu-kind-shader u32 2)
-(const gpu-kind-pipeline u32 3)
-(const gpu-kind-buffer u32 4)
-(const gpu-kind-texture u32 5)
-(const gpu-kind-sampler u32 6)
-(const gpu-kind-layout u32 7)
-(const gpu-kind-bind-group u32 8)
-
-;; ---- the buffer ----
-
-(define commands buffer)
-(define frame arena)
-
-(define (gpu-commands) -> (ptr buffer) (& commands))
-
-(define (gpu-commands-done!)
-  (set! (-> commands length) 0)
-  (arena-free (& frame)))
-
-(define (gpu-frame-alloc [n u32]) -> (ptr void) (arena-alloc (& frame) n))
-
-(define (gpu-frame-copy [p (ptr void)] [n u32]) -> (ptr void)
-  (let ([copy (gpu-frame-alloc n)])
-    (memcpy copy p n)
-    copy))
-
-(define (words! [w (slice u32)]) (buffer-add! (& commands) (slice (cast (ptr u8) (-> w items)) (* 4 (-> w length)))))
-
-(define (word! [w u32]) (words! (slice (array-of u32 w))))
-
-(define (float! [x f64]) (buffer-add! (& commands) (slice (cast (ptr u8) (array-of f32 (cast f32 x))) 4)))
-
-(define (text! [s string])
-  (let ([copy (cast (ptr u8) (gpu-frame-alloc (-> s length)))])
-    (memcpy copy (-> s bytes) (-> s length))
-    (words! (slice (array-of u32 (cast u32 copy) (-> s length))))))
-
-;; ---- the items a command still expects ----
-
-(define expected-layouts u32 0)
-(define expected-targets u32 0)
-(define expected-buffers u32 0)
-(define expected-attributes u32 0)
-(define expected-entries u32 0)
-(define expected-bindings u32 0)
-(define expected-pass-targets u32 0)
-(define expected-offsets u32 0)
-
-(define (complete!)
-  (when (or (> expected-layouts 0) (> expected-targets 0) (> expected-buffers 0) (> expected-attributes 0)
-            (> expected-entries 0) (> expected-bindings 0) (> expected-pass-targets 0) (> expected-offsets 0))
-    (host-trap "gpu: the last command is still waiting for its items (layouts, targets, attributes, entries or offsets)")))
-
-(define (item! [expected (ptr u32)] [unexpected string])
-  (when (== (@ expected) 0) (host-trap unexpected))
-  (-= (@ expected) 1))
-
-;; ---- numbers ----
-
-(define next-surface u32 1)
-(define next-shader u32 1)
-(define next-pipeline u32 1)
-(define next-buffer u32 1)
-(define next-texture u32 1)
-(define next-sampler u32 1)
-(define next-layout u32 1)
-(define next-bind-group u32 1)
-
-(define (fresh! [next (ptr u32)]) -> u32
-  (let ([n (@ next)])
-    (+= (@ next) 1)
-    n))
-
-;; ---- making resources ----
-
-(define (gpu-surface! [node u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-surface))])
-    (words! (slice (array-of u32 1 id node)))
-    id))
-
-(define (gpu-shader! [code string]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-shader))])
-    (words! (slice (array-of u32 2 id)))
-    (text! code)
-    id))
-
-(define (gpu-render-pipeline! [shader u32] [vertex string] [fragment string] [topology u32] [cull u32] [front u32]
-                              [blend u32] [depth-format u32] [depth-compare u32] [depth-write bool]
-                              [layouts u32] [targets u32] [buffers u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-pipeline))])
-    (words! (slice (array-of u32 3 id shader)))
-    (text! vertex)
-    (text! fragment)
-    (words! (slice (array-of u32 topology cull front blend depth-format depth-compare depth-write layouts)))
-    (set! expected-layouts layouts)
-    (set! expected-targets targets)
-    (set! expected-buffers buffers)
-    (set! rendering #t)
-    (when (== layouts 0) (after-layouts!))
-    id))
-
-(define rendering bool #f)
-
-(define (after-layouts!)
-  (when rendering
-    (word! expected-targets)
-    (when (== expected-targets 0) (after-targets!))))
-
-(define (after-targets!) (word! expected-buffers))
-
-(define (gpu-layout-item! [layout u32])
-  (item! (& expected-layouts) "gpu: no layout is expected here")
-  (word! layout)
-  (when (== expected-layouts 0) (after-layouts!)))
-
-(define (gpu-target! [format u32])
-  (item! (& expected-targets) "gpu: no target is expected here")
-  (word! format)
-  (when (== expected-targets 0) (after-targets!)))
-
-(define (gpu-vertex-buffer-layout! [stride u32] [step u32] [attributes u32])
-  (when (> expected-attributes 0) (host-trap "gpu: the attributes of the last vertex buffer are not complete"))
-  (item! (& expected-buffers) "gpu: no vertex buffer layout is expected here")
-  (words! (slice (array-of u32 stride step attributes)))
-  (set! expected-attributes attributes))
-
-(define (gpu-attribute! [location u32] [offset u32] [format u32])
-  (item! (& expected-attributes) "gpu: no attribute is expected here")
-  (words! (slice (array-of u32 location offset format))))
-
-(define (gpu-compute-pipeline! [shader u32] [entry string] [layouts u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-pipeline))])
-    (words! (slice (array-of u32 4 id shader)))
-    (text! entry)
-    (word! layouts)
-    (set! expected-layouts layouts)
-    (set! rendering #f)
-    id))
-
-(define (gpu-buffer! [size u32] [usage u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-buffer))])
-    (words! (slice (array-of u32 5 id size usage)))
-    id))
-
-(define (gpu-texture! [width u32] [height u32] [layers u32] [mips u32] [format u32] [usage u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-texture))])
-    (words! (slice (array-of u32 6 id width height layers mips format usage)))
-    id))
-
-(define (gpu-texture-file! [path string]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-texture))])
-    (words! (slice (array-of u32 7 id)))
-    (text! path)
-    id))
-
-(define (gpu-sampler! [filter u32] [address u32] [compare u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-sampler))])
-    (words! (slice (array-of u32 8 id filter address compare)))
-    id))
-
-(define (gpu-layout! [n u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-layout))])
-    (words! (slice (array-of u32 9 id n)))
-    (set! expected-entries n)
-    id))
-
-(define (gpu-layout-entry! [binding u32] [visibility u32] [kind u32])
-  (item! (& expected-entries) "gpu: no layout entry is expected here")
-  (words! (slice (array-of u32 binding visibility kind))))
-
-(define (gpu-bind-group! [layout u32] [pipeline u32] [group u32] [n u32]) -> u32
-  (complete!)
-  (let ([id (fresh! (& next-bind-group))])
-    (words! (slice (array-of u32 10 id layout pipeline group n)))
-    (set! expected-bindings n)
-    id))
-
-(define (gpu-bind-buffer! [binding u32] [buffer u32] [offset u32] [size u32])
-  (item! (& expected-bindings) "gpu: no binding is expected here")
-  (words! (slice (array-of u32 binding 1 buffer offset size))))
-
-(define (gpu-bind-sampler! [binding u32] [sampler u32])
-  (item! (& expected-bindings) "gpu: no binding is expected here")
-  (words! (slice (array-of u32 binding 2 sampler 0 0))))
-
-(define (gpu-bind-texture! [binding u32] [texture u32])
-  (item! (& expected-bindings) "gpu: no binding is expected here")
-  (words! (slice (array-of u32 binding 3 texture 0 0))))
-
-(define (gpu-destroy! [kind u32] [id u32])
-  (complete!)
-  (words! (slice (array-of u32 11 kind id))))
-
-;; ---- writing and reading ----
-
-(define (gpu-write-buffer! [buffer u32] [offset u32] [p (ptr void)] [n u32])
-  (complete!)
-  (words! (slice (array-of u32 12 buffer offset (cast u32 p) n))))
-
-(define (gpu-write-texture! [texture u32] [mip u32] [layer u32] [x u32] [y u32] [w u32] [h u32] [p (ptr void)] [n u32])
-  (complete!)
-  (words! (slice (array-of u32 13 texture mip layer x y w h (cast u32 p) n))))
-
-(define (gpu-read-texture! [texture u32] [mip u32] [layer u32] [x u32] [y u32] [w u32] [h u32])
-  (complete!)
-  (words! (slice (array-of u32 14 texture mip layer x y w h))))
-
-(define (gpu-read-buffer! [buffer u32] [offset u32] [n u32])
-  (complete!)
-  (words! (slice (array-of u32 15 buffer offset n))))
-
-;; ---- passes ----
-
-(define (gpu-render-pass! [targets u32] [depth-texture u32] [depth-mip u32] [depth-layer u32] [depth-load u32] [depth-clear f64])
-  (complete!)
-  (words! (slice (array-of u32 16 targets)))
-  (set! expected-pass-targets targets)
-  (set! pending-depth-texture depth-texture)
-  (set! pending-depth-mip depth-mip)
-  (set! pending-depth-layer depth-layer)
-  (set! pending-depth-load depth-load)
-  (set! pending-depth-clear depth-clear)
-  (when (== targets 0) (depth!)))
-
-(define pending-depth-texture u32 0)
-(define pending-depth-mip u32 0)
-(define pending-depth-layer u32 0)
-(define pending-depth-load u32 0)
-(define pending-depth-clear f64 0.0)
-
-(define (depth!)
-  (words! (slice (array-of u32 pending-depth-texture pending-depth-mip pending-depth-layer pending-depth-load)))
-  (float! pending-depth-clear))
-
-(define (gpu-pass-target! [kind u32] [id u32] [mip u32] [layer u32] [load u32] [r f64] [g f64] [b f64] [a f64])
-  (item! (& expected-pass-targets) "gpu: no pass target is expected here")
-  (words! (slice (array-of u32 kind id mip layer load)))
-  (float! r)
-  (float! g)
-  (float! b)
-  (float! a)
-  (when (== expected-pass-targets 0) (depth!)))
-
-(define (gpu-compute-pass!)
-  (complete!)
-  (word! 17))
-
-(define (gpu-end-pass!)
-  (complete!)
-  (word! 18))
-
-(define (gpu-pipeline! [pipeline u32])
-  (complete!)
-  (words! (slice (array-of u32 19 pipeline))))
-
-(define (gpu-bind-group-set! [group u32] [bind-group u32] [n u32])
-  (complete!)
-  (words! (slice (array-of u32 20 group bind-group n)))
-  (set! expected-offsets n))
-
-(define (gpu-offset! [offset u32])
-  (item! (& expected-offsets) "gpu: no offset is expected here")
-  (word! offset))
-
-(define (gpu-vertex-buffer! [slot u32] [buffer u32] [offset u32])
-  (complete!)
-  (words! (slice (array-of u32 21 slot buffer offset))))
-
-(define (gpu-index-buffer! [buffer u32] [format u32] [offset u32])
-  (complete!)
-  (words! (slice (array-of u32 22 buffer format offset))))
-
-(define (gpu-draw! [vertices u32] [instances u32] [first-vertex u32] [first-instance u32])
-  (complete!)
-  (words! (slice (array-of u32 23 vertices instances first-vertex first-instance))))
-
-(define (gpu-draw-indexed! [indexes u32] [instances u32] [first-index u32] [base-vertex u32] [first-instance u32])
-  (complete!)
-  (words! (slice (array-of u32 24 indexes instances first-index base-vertex first-instance))))
-
-(define (gpu-dispatch! [x u32] [y u32] [z u32])
-  (complete!)
-  (words! (slice (array-of u32 25 x y z))))
-
-(define (gpu-viewport! [x f64] [y f64] [w f64] [h f64])
-  (complete!)
-  (word! 26)
-  (float! x)
-  (float! y)
-  (float! w)
-  (float! h))
-
-(define (gpu-scissor! [x u32] [y u32] [w u32] [h u32])
-  (complete!)
-  (words! (slice (array-of u32 27 x y w h))))
+(define (gpu-send!)
+  (unless batch-begun (host-trap "gpu: gpu-send! was called without gpu-begin!"))
+  (set! batch-begun #f)
+  (let ([b (gpu-commands)])
+    (when (> (-> b length) 0) (gpu-apply (buffer-bytes b) batch-tag)))
+  (gpu-commands-done!))

package/std/web/patches.sub

@@ -1,15 +1,19 @@
-;; Changes to the page, written as patches for the host module "dom". dom.sub sends them. A template is HTML in which
-;; the nodes a program will change are marked: elements with a data-n attribute, <!--t--> for a text node, and <!--a-->
-;; for a place that other pieces can be put before. dom-add! puts a piece, a copy of a template, on the page and returns
-;; the piece's number; its marked nodes are numbered after it, in document order. The strings these functions take are
-;; copied, and the copies last until the patches are sent or dom-discard! drops them.
+;; Changes to the document, written as patches for the host module "dom". dom.sub sends them. A template is HTML in
+;; which the nodes a program will change are marked: elements with a data-n attribute, <!--t--> for a text node, and
+;; <!--a--> for a place that other pieces can be put before. dom-add! puts a piece, a copy of a template, in the document
+;; and returns the piece's number; its marked nodes are numbered after it, in document order. The strings these
+;; functions take are copied, and the copies last until the patches are sent or dom-discard! drops them.
 (provide dom-template dom-add! dom-remove! dom-forget! dom-move! dom-set-text! dom-set-attr! dom-remove-attr! dom-listen!
-         dom-listen-window! dom-focus! dom-scroll-to-end! dom-pointer-lock! dom-image! dom-discard! dom-patches
-         dom-frame-alloc dom-flushes)
+         dom-listen-window! dom-value dom-number dom-text dom-write-number! dom-write-text! dom-call! dom-call-with!
+         dom-document dom-image! dom-stylesheet! dom-new-node!
+         dom-discard! dom-patches dom-frame-alloc dom-flushes)
+
+;; The document's node number. The root's number is 0.
+(const dom-document u32 1)
 
 (define patches buffer)
 (define frame arena)
-(define next-id u32 1)
+(define next-id u32 2)
 (define next-template u32 1)
 (define flushes u32 0)
 (define counts buffer)
@@ -45,8 +49,8 @@
     (words! (slice (array-of u32 2 template first n parent before)))
     first))
 
-;; dom-remove! takes a piece off the page and forgets its nodes. dom-forget! only forgets them, for a piece that was
-;; inside one taken off.
+;; dom-remove! takes a piece out of the document and forgets its nodes. dom-forget! only forgets them, for a piece that
+;; was inside one taken out.
 (define (dom-remove! [first u32] [template u32]) (words! (slice (array-of u32 3 first (size-of template)))))
 (define (dom-forget! [first u32] [template u32]) (words! (slice (array-of u32 4 first (size-of template)))))
 
@@ -106,22 +110,53 @@
   (let ([n (kept name)]) (words! (slice (array-of u32 8 node (cast u32 (-> n bytes)) (-> n length))))))
 
 ;; dom-listen! sends the node's event to tag's handler, and dom-listen-window! sends the window's event there while the
-;; node is on the page.
+;; node is in the document.
 (define (dom-listen! [node u32] [event string] [tag (ptr void)])
   (let ([e (kept event)]) (words! (slice (array-of u32 9 node (cast u32 (-> e bytes)) (-> e length) (cast u32 tag))))))
 
 (define (dom-listen-window! [node u32] [event string] [tag (ptr void)])
-  (let ([e (kept event)]) (words! (slice (array-of u32 12 node (cast u32 (-> e bytes)) (-> e length) (cast u32 tag))))))
+  (let ([e (kept event)]) (words! (slice (array-of u32 10 node (cast u32 (-> e bytes)) (-> e length) (cast u32 tag))))))
+
+;; Writes and calls name a property or method as reads do (dom.sub), starting at the node. They happen after the other
+;; patches sent with them.
+(variant dom-value [dom-number [n f64]] [dom-text [s string]])
+
+(define (value! [v (ptr dom-value)])
+  (match v
+    [(dom-number n)
+     (let ([b (cast u64 (f64-bits n))]) (words! (slice (array-of u32 0 (cast u32 b) (cast u32 (>> b 32))))))]
+    [(dom-text s)
+     (let ([t (kept s)]) (words! (slice (array-of u32 1 (cast u32 (-> t bytes)) (-> t length)))))]))
+
+(define (write! [node u32] [path string] [v dom-value])
+  (let ([p (kept path)])
+    (words! (slice (array-of u32 14 node (cast u32 (-> p bytes)) (-> p length))))
+    (value! (& v))))
 
-(define (dom-focus! [node u32]) (words! (slice (array-of u32 10 node))))
+(define (dom-write-number! [node u32] [path string] [n f64]) (write! node path (dom-number n)))
 
-(define (dom-scroll-to-end! [node u32]) (words! (slice (array-of u32 11 node))))
+(define (dom-write-text! [node u32] [path string] [s string]) (write! node path (dom-text s)))
 
-(define (dom-pointer-lock! [node u32] [on bool]) (words! (slice (array-of u32 15 node (if on 1 0)))))
+(define (dom-call-with! [node u32] [method string] [arguments (slice dom-value)])
+  (let ([m (kept method)])
+    (words! (slice (array-of u32 15 node (cast u32 (-> m bytes)) (-> m length) (-> arguments length))))
+    (for ([i u32 0]) (< i (-> arguments length)) (+= i 1) (value! (& (@ arguments i))))))
 
-;; dom-image! loads the image at path under the number id, for canvas-load-image! (canvas.sub).
-(define (dom-image! [id u32] [path string])
-  (let ([p (kept path)]) (words! (slice (array-of u32 14 id (cast u32 (-> p bytes)) (-> p length))))))
+(define (dom-call! [node u32] [method string]) (dom-call-with! node method (slice (cast (ptr dom-value) 0) 0)))
+
+;; dom-image! loads the image at path under the number id, for canvas-load-image! (canvas.sub). Its loaded or failed
+;; event goes to tag.
+(define (dom-image! [id u32] [path string] [tag (ptr void)])
+  (let ([p (kept path)]) (words! (slice (array-of u32 12 id (cast u32 (-> p bytes)) (-> p length) (cast u32 tag))))))
+
+(define (dom-stylesheet! [css string])
+  (let ([c (kept css)]) (words! (slice (array-of u32 13 (cast u32 (-> c bytes)) (-> c length))))))
+
+;; A fresh node number, for dom-element (dom.sub).
+(define (dom-new-node!) -> u32
+  (let ([n next-id])
+    (+= next-id 1)
+    n))
 
 (define (dom-discard!)
   (set! (-> patches length) 0)

package/substrate/VERSION

@@ -1 +1 @@
-0.10.0
+0.10.2

package/substrate/compiler/expander.sub

@@ -1069,10 +1069,9 @@
        (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.
+;; load-cached loads the module at path from the program's compiled modules when they hold it, or else from the cache.
 (define (load-cached [path datum]) -> datum
-  (if (if (compiled-root? path) (== (compiled-module path) 0) (== (cache-compiler) 0))
+  (if (and (== (compiled-module path) 0) (or (compiled-root? path) (== (cache-compiler) 0)))
       0
       (begin
         (begin-module-arena)

package/substrate/compiler/roots.sub

@@ -9,8 +9,8 @@
 (provide set-toolchain-directory! set-module-map! set-module-map-text! set-display-directory! toolchain-root? toolchain-roots
          toolchain-holding root-directories root-under-test? identity identity-label host-file entry-identity program-identity
          set-compiled-module-map! compiled-module-map compiled-module compiled-root? module-source-file module-path-from
-         module-identity named-file program-forms language-path compiler-file module-source? string-literal? displayed
-         write-error fail-at read-text file-text host-error module-refusal)
+         module-identity named-file named-directory program-forms language-path compiler-file module-source?
+         string-literal? displayed write-error fail-at read-text file-text host-error module-refusal)
 
 (define (symbol-of [s datum]) -> datum (string->symbol (datum->string s)))
 
@@ -183,10 +183,12 @@
 (define (set-module-map-text! [text datum] [source datum])
   (set-module-map! (map (lambda ([f datum]) -> datum (syntax->datum f)) (read-text text (symbol-of source)))))
 
-;; set-compiled-module-map! replaces the roots with those of the program's compiled modules, which have no directories.
+;; set-compiled-module-map! gives sessions the program's compiled modules. When the program has given no roots with
+;; directories, it also replaces the roots with those of the compiled modules, which have no directories.
 (define (set-compiled-module-map! [forms datum] [modules datum])
-  (set! toolchain-directory 0)
-  (set-module-map! forms)
+  (when (null? (root-directories))
+    (set! toolchain-directory 0)
+    (set-module-map! forms))
   (set! compiled (keep modules)))
 
 ;; compiled-module-map returns the module map without directories, which a build writes next to the program's compiled
@@ -390,6 +392,11 @@
   (let ([file (concat rest '".sub")] [inner (file-in rest (concat (last-part rest) '".sub"))])
     (if (and (== (compiled-module (identity label file)) 0) (!= (compiled-module (identity label inner)) 0)) inner file)))
 
+;; named-directory gives the directory that name stands for in a require from file, or #f for a root of compiled modules.
+(define (named-directory [file datum] [name datum]) -> datum
+  (let ([r (root-holding (absolute file))])
+    (cadr (root-in (named-root 0 name (if (== r 0) program-label (car r)) roots) roots))))
+
 ;; naming-label returns the root used to resolve module names in code from a given module: that module's root, or the
 ;; program's root for code outside any root, such as session input.
 (define (naming-label [from datum]) -> datum

package/substrate/host/grants.mjs

@@ -1,7 +1,7 @@
 // What a program may do beyond computing: read and write files, reach hosts, read the environment and run
-// programs. The grants match Deno's permissions wherever the two overlap, except that the host never prompts, a page
-// cannot check where fetch is redirected or where names resolve, and a child may keep the dynamic loader's variables
-// the host started with.
+// programs. The grants match Deno's permissions wherever the two overlap, except that the host never prompts, a web
+// program cannot check where fetch is redirected or where names resolve, and a child may keep the dynamic loader's
+// variables the host started with.
 const kinds = ['read', 'write', 'net', 'env', 'run'];
 export const flags = {
   read: '--allow-read', write: '--allow-write', net: '--allow-net', env: '--allow-env', run: '--allow-run',

package/substrate/host/node/net.mjs

@@ -1,4 +1,5 @@
-// The host module "net" (net.sub).
+// The host module "net" (net.sub). A TLS server reloads its certificate and key when their files change.
+import fs from 'node:fs';
 import net from 'node:net';
 import tls from 'node:tls';
 import { errorOf, reasonOf } from '../errors.mjs';
@@ -14,6 +15,19 @@ const ACCEPT = 2;
 const CONNECTED = 3;
 const FAILED = 4;
 
+function renewed(server, certificate) {
+  const [certFile, keyFile] = certificate.files;
+  const reload = () => {
+    try {
+      server.setSecureContext({ cert: fs.readFileSync(certFile), key: fs.readFileSync(keyFile) });
+    } catch {}
+  };
+  for (const file of certificate.files) fs.watchFile(file, { interval: 1000, persistent: false }, reload);
+  server.once('close', () => {
+    for (const file of certificate.files) fs.unwatchFile(file, reload);
+  });
+}
+
 export function netModule(grants, certificate) {
   const listeners = new Map();
   const ca = certificate ? [...tls.rootCertificates, certificate.cert] : undefined;
@@ -39,9 +53,10 @@ export function netModule(grants, certificate) {
             throw new Error('net.listen: TLS needs the host started with --tls-cert and --tls-key');
           }
           server = secure
-            ? tls.createServer({ ...certificate, allowHalfOpen: true })
+            ? tls.createServer({ cert: certificate.cert, key: certificate.key, allowHalfOpen: true })
             : net.createServer({ allowHalfOpen: true });
           if (most > 0) server.maxConnections = most;
+          if (secure && certificate.files) renewed(server, certificate);
           if (addressDenials(grants.net) && !net.isIP(host)) {
             lookupWithin(grants, 'net.listen', port)(host, {}, (e, address) => {
               if (listeners.get(id) !== server) return;

package/substrate/host/node/worker.mjs

@@ -30,7 +30,9 @@ export function workers(setup) {
     spawn(plan) {
       const { port1, port2 } = new MessageChannel();
       const signal = new Int32Array(new SharedArrayBuffer(4));
-      const tls = plan.tls ? { cert: read(plan.tls.cert), key: read(plan.tls.key) } : setup.tls;
+      const tls = plan.tls
+        ? { cert: read(plan.tls.cert), key: read(plan.tls.key), files: [plan.tls.cert, plan.tls.key] }
+        : setup.tls;
       const thread = new Worker(new URL('./worker-thread.mjs', import.meta.url));
       // The messages a thread posted before it ended, which can still wait on the port when its exit is heard.
       let heard = null;