substrate-lang 0.9.4 → 0.10.1

package/substrate/host/web/location.mjs

@@ -1,4 +1,6 @@
 // The host module "location" (location.sub).
+import { errorOf } from '../errors.mjs';
+
 const utf8 = new TextEncoder();
 
 const SOURCE = 12;
@@ -6,14 +8,19 @@ const CHANGED = 1;
 
 export function locationModule() {
   return (caller) => {
-    const popped = () => caller.event(CHANGED, 0, 0, 0, utf8.encode(globalThis.location.href));
+    const listeners = new Map();
+    let next = 1;
+    const popped = () => {
+      const url = utf8.encode(globalThis.location.href);
+      for (const [id, tag] of listeners) caller.event(CHANGED, id, tag, 0, url);
+    };
     addEventListener('popstate', popped);
     const move = (go, ptr, len, err) => {
       try {
         go(caller.string(ptr, len));
         return 0;
       } catch (e) {
-        caller.fail(err, e.message);
+        caller.fail(err, e.message, errorOf(e));
         return -1;
       }
     };
@@ -28,6 +35,15 @@ export function locationModule() {
       back() {
         history.back();
       },
+      listen(tag) {
+        const id = next++;
+        listeners.set(id, tag);
+        return id;
+      },
+      unlisten(id) {
+        listeners.delete(id);
+        caller.forget(id);
+      },
     };
   };
 }

package/substrate/host/web/location.sub

@@ -1,21 +1,33 @@
-;; The page's URL and history: the host module "location". When the user goes back or forward, an untagged changed
-;; event brings the URL as its bytes.
-(provide location-source location-changed location-get location-push location-replace location-back)
+;; The page's URL and history: the host module "location". When the user goes back or forward, each listener's tag
+;; gets a changed event with the URL as its bytes. location-listen gives the listener's number, and location-unlisten
+;; takes it.
+(provide location-source location-changed location-get location-push location-replace location-back location-listen
+         location-unlisten)
 
 (import get "location" "get" (i32 -> i32))
 (import push "location" "push" (i32 i32 i32 -> i32))
 (import replace "location" "replace" (i32 i32 i32 -> i32))
 (import back "location" "back" (->))
+(import listen "location" "listen" (i32 -> i32))
+(import unlisten "location" "unlisten" (i32 ->))
 
 (const location-source u32 12)
 (const location-changed u32 1)
 
 (define (location-get) -> string (let* ([n u32 0] [p (get (cast i32 (& n)))]) (cast string (slice (cast (ptr u8) p) n))))
 
-(define (location-push [url string] [err (ptr string)]) -> i32
-  (push (cast i32 (-> url bytes)) (cast i32 (-> url length)) (cast i32 err)))
+(define (location-push [url string] [err (ptr error)]) -> bool
+  (let ([why string])
+    (or (== (push (cast i32 (-> url bytes)) (cast i32 (-> url length)) (cast i32 (& why))) 0)
+        (host-failed! (& why) err))))
 
-(define (location-replace [url string] [err (ptr string)]) -> i32
-  (replace (cast i32 (-> url bytes)) (cast i32 (-> url length)) (cast i32 err)))
+(define (location-replace [url string] [err (ptr error)]) -> bool
+  (let ([why string])
+    (or (== (replace (cast i32 (-> url bytes)) (cast i32 (-> url length)) (cast i32 (& why))) 0)
+        (host-failed! (& why) err))))
 
 (define (location-back) (back))
+
+(define (location-listen [tag (ptr void)]) -> u32 (cast u32 (listen (cast i32 tag))))
+
+(define (location-unlisten [id u32]) (unlisten (cast i32 id)))

package/substrate/host/worker-side.mjs

@@ -1,5 +1,7 @@
 // The worker module's side inside a worker, in a browser or on Node. It batches output, delivers the parent's
 // messages as events, and reports back.
+import { errors } from './errors.mjs';
+
 const utf8 = new TextEncoder();
 
 const SOURCE = 3;
@@ -72,7 +74,7 @@ export function workerSide(post) {
   const worker = (caller) => ({
     source: SOURCE,
     start(f, bp, bl, time, size, heard, tag, gp, gl, err) {
-      caller.fail(err, 'worker.start: a worker cannot start workers');
+      caller.fail(err, 'worker.start: a worker cannot start workers', errors.invalid);
       return 0;
     },
     send(w, ptr, length) {

package/substrate/host/worker.mjs

@@ -1,6 +1,7 @@
 // The host module "worker" (worker.sub). The browser and Node each give spawn, their way of starting a thread.
 import { entries } from './entries.mjs';
-import { askedOf, mayTree, within } from './grants.mjs';
+import { errors, errorOf } from './errors.mjs';
+import { askedOf, mayTree, notGranted, within } from './grants.mjs';
 
 const utf8 = new TextEncoder();
 
@@ -69,7 +70,7 @@ export function workerModule({ spawn }) {
       thread = spawn({ modules, compiled, entry, argument, grants, names: caller.moduleNames(), pages, heard, ...setup },
                      app);
     } catch (e) {
-      caller.fail(err, e.message);
+      caller.fail(err, e.message, errorOf(e));
       return 0;
     }
     const w = nextNumber++;
@@ -100,7 +101,7 @@ export function workerModule({ spawn }) {
       start(f, bp, bl, time, size, heard, tag, gp, gl, err, ends, ap, al) {
         const entry = caller.named(f >>> 0);
         if (!entry) {
-          caller.fail(err, 'worker.start: a function of code the program loaded');
+          caller.fail(err, 'worker.start: a function of code the program loaded', errors.invalid);
           return 0;
         }
         const pages = Math.ceil((size >>> 0) / 65536);
@@ -113,11 +114,11 @@ export function workerModule({ spawn }) {
           const parent = caller.grants();
           const files = caller.parseGrants(read.flatMap((file) => ['read', file])).grants.read.items;
           for (const file of files) {
-            if (!mayTree(parent.read, file)) throw new Error(`read ${file} reaches beyond the parent's grants`);
+            if (!mayTree(parent.read, file)) throw notGranted(`read ${file} reaches beyond the parent's grants`);
           }
           grants = within(askedOf(request, parent), parent);
         } catch (e) {
-          caller.fail(err, `worker.start: ${e.message}`);
+          caller.fail(err, `worker.start: ${e.message}`, errorOf(e));
           return 0;
         }
         const args = al > 0 ? entries(string(ap, al)) : null;

package/substrate/host/worker.sub

@@ -1,6 +1,5 @@
 ;; Workers: functions of this program, each running on its own thread and sharing only messages. worker-start runs one
-;; of the program's own functions with the bytes as its argument 0, and returns the worker's number, or 0 with the
-;; reason at err. Its options:
+;; of the program's own functions with the bytes as its argument 0. Its options:
 ;;   time, memory  limits in ms for each stretch of work and in bytes, or 0 for none
 ;;   output        the worker's stdout and stderr come as events
 ;;   grants        the worker's grants (grants.sub), within the parent's and by default the parent's own
@@ -41,22 +40,23 @@
   (set! (-> o grants) (make-grants))
   (grants-inherit! (& (-> o grants))))
 
-(define (worker-start [function (fn ())] [argument (slice u8)] [o (ptr worker-options)] [tag (ptr void)]
-                      [err (ptr string)]) -> u32
-  (let ([defaults worker-options] [p o] [entries (make-buffer)] [args (make-buffer)] [id u32 0])
+(define (worker-start [function (fn ())] [argument (slice u8)] [o (ptr worker-options)] [tag (ptr void)] [id (ptr u32)]
+                      [err (ptr error)]) -> bool
+  (let ([defaults worker-options] [p o] [entries (make-buffer)] [args (make-buffer)] [why string] [n u32 0])
     (when (== p 0)
       (worker-options-init! (& defaults))
       (set! p (& defaults)))
     (grants-entries! (& entries) (& (-> p grants)))
     (buffer-add-entries! (& args) (-> p args))
-    (set! id (cast u32 (start (cast i32 function) (cast i32 (-> argument items)) (cast i32 (-> argument length))
-                              (cast i32 (-> p time)) (cast i32 (-> p memory)) (-> p output) (cast i32 tag)
-                              (cast i32 (-> entries bytes)) (cast i32 (-> entries length)) (cast i32 err) (-> p ends)
-                              (cast i32 (-> args bytes)) (cast i32 (-> args length)))))
+    (set! n (cast u32 (start (cast i32 function) (cast i32 (-> argument items)) (cast i32 (-> argument length))
+                             (cast i32 (-> p time)) (cast i32 (-> p memory)) (-> p output) (cast i32 tag)
+                             (cast i32 (-> entries bytes)) (cast i32 (-> entries length)) (cast i32 (& why))
+                             (-> p ends) (cast i32 (-> args bytes)) (cast i32 (-> args length)))))
     (buffer-free! (& entries))
     (buffer-free! (& args))
     (when (== o 0) (buffer-free! (& (-> defaults grants list))))
-    id))
+    (unless (== id 0) (set! (@ id) n))
+    (or (!= n 0) (host-failed! (& why) err))))
 
 (define (worker-send [w u32] [b (slice u8)]) -> i32 (send (cast i32 w) (cast i32 (-> b items)) (cast i32 (-> b length))))