substrate-lang 0.9.2 → 0.9.4

package/substrate/host/fs.sub

@@ -5,7 +5,7 @@
 ;; 0, or -1 when they fail, and store a failure's reason at err.
 (provide fs-read-file fs-write-file fs-make-dir fs-info fs-stat fs-lstat fs-list fs-remove fs-rename
          fs-read-link fs-real-path fs-symlink fs-copy fs-chmod fs-make-temp-dir fs-make-temp-file
-         fs-cwd fs-file fs-directory fs-link fs-other
+         fs-cwd fs-kind fs-none fs-file fs-directory fs-link fs-other
          fs-open-file fs-read-at fs-write-at fs-set-size fs-sync fs-size fs-close-file fs-read-stream fs-write-stream
          fs-read-flag fs-write-flag fs-append-flag fs-truncate-flag fs-create-flag fs-create-new-flag)
 
@@ -32,20 +32,17 @@
 (import file_stream "fs" "file_stream" (i32 i32 f64 i32 i32 -> i32))
 
 ;; An fs-info's kind.
-(const fs-file i32 1)
-(const fs-directory i32 2)
-(const fs-link i32 3)
-(const fs-other i32 4)
+(enum fs-kind fs-none fs-file fs-directory fs-link fs-other)
 
 ;; modified is in milliseconds since 1970, and mode is the file's mode bits, its type's included.
-(struct fs-info [kind i32] [size i64] [modified f64] [mode u32])
+(struct fs-info [kind fs-kind] [size i64] [modified f64] [mode u32])
 
 (define (fs-make-dir [path string] [err (ptr string)]) -> i32
   (make_dir (cast i32 (-> path bytes)) (cast i32 (-> path length)) (cast i32 err)))
 
 (define (stat-of [path string] [follow bool] [i (ptr fs-info)] [err (ptr string)]) -> i32
   (let ([(kind size modified mode) (info (cast i32 (-> path bytes)) (cast i32 (-> path length)) follow (cast i32 err))])
-    (set! (-> i kind) kind)
+    (set! (-> i kind) (cast fs-kind kind))
     (set! (-> i size) (cast i64 size))
     (set! (-> i modified) modified)
     (set! (-> i mode) (cast u32 mode))
@@ -155,11 +152,11 @@
     (when (== h 0) (return -1))
     (set! size (fs-size h err))
     (set! room (if (> size 0) (+ (cast u32 (if (> size 2147483583) 2147483583 size)) 1) 4096))
-    (set! p (cast (ptr u8) (try-malloc room)))
+    (set! p (try-malloc room))
     (while (!= p 0)
       (set! got (fs-read-at h (slice (+ p n) (- room n)) (cast i64 n) err))
       (when (< got 0)
-        (free (cast (ptr void) p))
+        (free p)
         (fs-close-file h 0)
         (return -1))
       (+= n (cast u32 got))
@@ -167,8 +164,8 @@
         (fs-close-file h 0)
         (set! (@ into) (slice p n))
         (return 0))
-      (set! more (cast (ptr u8) (try-realloc (cast (ptr void) p) (* room 2))))
-      (when (== more 0) (free (cast (ptr void) p)))
+      (set! more (try-realloc p (* room 2)))
+      (when (== more 0) (free p))
       (set! p more)
       (set! room (* room 2)))
     (fs-close-file h 0)

package/substrate/host/grants.sub

@@ -8,18 +8,14 @@
 ;;   tls-cert tls-key          a file
 ;; grants-parse! reads flags as people type them, like -R=a,b, where ",," is a comma inside an item, and grants-add! a
 ;; clause as manifests and tests write one, like (read "a" "b"), (all net) or (tls "cert.pem" "key.pem").
-(provide grant grants grant-read grant-write grant-net grant-env grant-run make-grants grants-allow! grants-deny!
+(provide grant grants grant-kind grant-read grant-write grant-net grant-env grant-run make-grants grants-allow! grants-deny!
          grants-allow-all! grants-deny-all! grants-all! grants-inherit! grants-fake! grants-fetch! grants-tls!
          grants-join! grants-parse! grants-flag? grants-add! grants-entries! grants-arguments)
 
 (struct grant [kind string] [item string])
 (struct grants [list buffer])
 
-(const grant-read u32 0)
-(const grant-write u32 1)
-(const grant-net u32 2)
-(const grant-env u32 3)
-(const grant-run u32 4)
+(enum grant-kind grant-read grant-write grant-net grant-env grant-run)
 
 (define (make-grants) -> grants
   (let ([g grants])
@@ -30,22 +26,24 @@
   (let ([e (grant #:kind kind #:item item)])
     (buffer-add! (& (-> g list)) (slice (cast (ptr u8) (& e)) (sizeof grant)))))
 
-(define (allowed [k u32]) -> string (let ([names (array-of string "read" "write" "net" "env" "run")]) (@ names k)))
+(define (allowed [k grant-kind]) -> string
+  (match k [grant-read "read"] [grant-write "write"] [grant-net "net"] [grant-env "env"] [grant-run "run"]))
 
-(define (denied [k u32]) -> string
-  (let ([names (array-of string "deny-read" "deny-write" "deny-net" "deny-env" "deny-run")]) (@ names k)))
+(define (denied [k grant-kind]) -> string
+  (match k [grant-read "deny-read"] [grant-write "deny-write"] [grant-net "deny-net"] [grant-env "deny-env"] [grant-run "deny-run"]))
 
-(define (grants-allow! [g (ptr grants)] [k u32] [item string]) (added! g (allowed k) item))
+(define (grants-allow! [g (ptr grants)] [k grant-kind] [item string]) (added! g (allowed k) item))
 
-(define (grants-deny! [g (ptr grants)] [k u32] [item string]) (added! g (denied k) item))
+(define (grants-deny! [g (ptr grants)] [k grant-kind] [item string]) (added! g (denied k) item))
 
-(define (grants-allow-all! [g (ptr grants)] [k u32]) (added! g "all" (allowed k)))
+(define (grants-allow-all! [g (ptr grants)] [k grant-kind]) (added! g "all" (allowed k)))
 
-(define (grants-deny-all! [g (ptr grants)] [k u32]) (added! g "all" (denied k)))
+(define (grants-deny-all! [g (ptr grants)] [k grant-kind]) (added! g "all" (denied k)))
 
-(define (grants-all! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (grants-allow-all! g k)))
+(define (grants-all! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (grants-allow-all! g (cast grant-kind k))))
 
-(define (grants-inherit! [g (ptr grants)]) (for ([k u32 0]) (< k 5) (+= k 1) (added! g "inherit" (allowed k))))
+(define (grants-inherit! [g (ptr grants)])
+  (for ([k u32 0]) (< k 5) (+= k 1) (added! g "inherit" (allowed (cast grant-kind k)))))
 
 (define (grants-fake! [g (ptr grants)] [name string]) (added! g "fake" name))
 
@@ -87,20 +85,20 @@
   (for ([i u32 0]) (< i (-> s length)) (+= i 1) (when (== (@ s i) #\=) (return i)))
   (-> s length))
 
-(define (kind-of [name string] [k (ptr u32)]) -> bool
+(define (kind-of [name string] [k (ptr grant-kind)]) -> bool
   (let ([shorts (array-of string "-R" "-W" "-N" "-E" "--allow-run")]
         [longs (array-of string "--allow-read" "--allow-write" "--allow-net" "--allow-env" "--allow-run")])
     (for ([i u32 0]) (< i 5) (+= i 1)
       (when (or (== name (@ shorts i)) (== name (@ longs i)))
-        (set! (@ k) i)
+        (set! (@ k) (cast grant-kind i))
         (return #t)))
     #f))
 
-(define (denial-of [name string] [k (ptr u32)]) -> bool
+(define (denial-of [name string] [k (ptr grant-kind)]) -> bool
   (let ([names (array-of string "--deny-read" "--deny-write" "--deny-net" "--deny-env" "--deny-run")])
     (for ([i u32 0]) (< i 5) (+= i 1)
       (when (== name (@ names i))
-        (set! (@ k) i)
+        (set! (@ k) (cast grant-kind i))
         (return #t)))
     #f))
 
@@ -160,7 +158,7 @@
 (define (grants-parse! [g (ptr grants)] [flags (slice string)] [err (ptr string)]) -> bool
   (for ([i u32 0]) (< i (-> flags length)) (+= i 1)
     (let* ([flag (@ flags i)] [eq (equals-at flag)] [name (slice flag 0 eq)] [listed (< eq (-> flag length))]
-           [value (if listed (slice flag (+ eq 1) (-> flag length)) "")] [k u32 0])
+           [value (if listed (slice flag (+ eq 1) (-> flag length)) "")] [k grant-kind])
       (cond [(or (== name "-A") (== name "--allow-all"))
              (when listed (return (refused err name " takes no list")))
              (grants-all! g)]
@@ -178,21 +176,22 @@
   #t)
 
 (define (grants-flag? [s string]) -> bool
-  (let ([name (slice s 0 (equals-at s))] [k u32 0])
+  (let ([name (slice s 0 (equals-at s))] [k grant-kind])
     (or (== name "-A") (== name "--allow-all") (kind-of name (& k)) (denial-of name (& k)) (== name "--fake")
         (== name "--tls-cert") (== name "--tls-key"))))
 
 ;; ---- clauses ----
 
-(define (kind-named [name string] [deny bool] [k (ptr u32)]) -> bool
+(define (kind-named [name string] [deny bool] [k (ptr grant-kind)]) -> bool
   (for ([i u32 0]) (< i 5) (+= i 1)
-    (when (== name (if deny (denied i) (allowed i)))
-      (set! (@ k) i)
-      (return #t)))
+    (let ([c (cast grant-kind i)])
+      (when (== name (if deny (denied c) (allowed c)))
+        (set! (@ k) c)
+        (return #t))))
   #f)
 
 (define (grants-add! [g (ptr grants)] [head string] [items (slice string)] [err (ptr string)]) -> bool
-  (let ([k u32 0] [n (-> items length)])
+  (let ([k grant-kind] [n (-> items length)])
     (when (== n 0) (return (refused err head " has no items")))
     (for ([i u32 0]) (< i n) (+= i 1)
       (when (== (-> (@ items i) length) 0) (return (refused err head " has an empty item"))))

package/substrate/host/node/process.sub

@@ -20,11 +20,10 @@
 (const process-source u32 10)
 (const process-exit u32 1)
 (const process-failed u32 2)
-(const process-pipe i32 0)
-(const process-ignore i32 1)
-(const process-inherit i32 2)
+(enum process-stdio process-pipe process-ignore process-inherit)
 
-(struct process-options [dir string] [env (slice string)] [clear bool] [stdin i32] [stdout i32] [stderr i32])
+(struct process-options [dir string] [env (slice string)] [clear bool] [stdin process-stdio] [stdout process-stdio]
+        [stderr process-stdio])
 
 (define (process-options-init! [o (ptr process-options)])
   (set! (-> o dir) "")
@@ -44,8 +43,8 @@
     (buffer-add-entries! (& e) (-> p env))
     (set! id (cast u32 (spawn (cast i32 (-> program bytes)) (cast i32 (-> program length)) (cast i32 (-> a bytes))
                               (cast i32 (-> a length)) (cast i32 (-> p dir bytes)) (cast i32 (-> p dir length))
-                              (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (-> p stdin) (-> p stdout)
-                              (-> p stderr) (cast i32 tag) (cast i32 err))))
+                              (cast i32 (-> e bytes)) (cast i32 (-> e length)) (-> p clear) (cast i32 (-> p stdin))
+                              (cast i32 (-> p stdout)) (cast i32 (-> p stderr)) (cast i32 tag) (cast i32 err))))
     (buffer-free! (& a))
     (buffer-free! (& e))
     id))

package/substrate/host/node/worker-thread.mjs

@@ -44,7 +44,7 @@ parentPort.on('message', (m) => {
       absent: new Set(['stdin', 'signal']),
       memoryPages: m.pages,
     });
-    const entry = host.load([...wasm.keys()], (name) => wasm.get(name));
+    const entry = host.load([...wasm.keys()], (name) => wasm.get(name), m.compiled);
     if (!entry) {
       side.ended(2, host.lastError);
       return;

package/substrate/host/node/worker.mjs

@@ -42,6 +42,7 @@ export function workers(setup) {
       thread.postMessage({
         type: 'start',
         modules: plan.modules,
+        compiled: plan.compiled,
         entry: plan.entry,
         argument: plan.argument,
         grants: plan.grants,

package/substrate/host/subhost-core.mjs

@@ -174,9 +174,11 @@ export function createHost(platform) {
   // A memory's malloc, from the module that exports both.
   const allocators = new WeakMap();
   let lastError = '';
-  // The running program: its modules' names in load order, and how to get one's bytes.
+  // The running program: its module names in load order, a function that returns a module's bytes, and the files of
+  // the compiled modules its build wrote, keyed by file name (null if it wrote none).
   let programNames = [];
   let programBytes = null;
+  let programCompiled = null;
   let entry = null;
   let onEvent = null;
   let onTrap = null;
@@ -344,7 +346,7 @@ export function createHost(platform) {
       parseGrants: (list) => platform.parseGrants(list),
       moduleNames: () => (platform.modules ? [...platform.modules.keys()] : []),
       module: (name) => (platform.modules ? platform.modules.get(name) : undefined),
-      program: () => ({ names: programNames, bytes: programBytes }),
+      program: () => ({ names: programNames, bytes: programBytes, compiled: programCompiled }),
       // named gives the module and the export name of the program's function at the index in the table, or null.
       named(index) {
         const table = self.exports.table;
@@ -412,6 +414,10 @@ export function createHost(platform) {
         const name = string(np, nl);
         return programNames.includes(name) ? give(programBytes(name), out) : 0;
       },
+      compiled_file(np, nl, out) {
+        const bytes = programCompiled && programCompiled.get(string(np, nl));
+        return bytes ? give(bytes, out) : 0;
+      },
     };
   }
 
@@ -499,9 +505,10 @@ export function createHost(platform) {
     return true;
   }
 
-  function load(names, bytesOf) {
+  function load(names, bytesOf, compiled = null) {
     programNames = names;
     programBytes = bytesOf;
+    programCompiled = compiled;
     running = true;
     try {
       for (const name of names) {

package/substrate/host/subhost.mjs

@@ -61,6 +61,18 @@ const names = read(`${dir}/program`).toString().split(/\r?\n/).filter((n) => n !
 const outside = names.find((name) => /[/\\]/.test(name));
 if (outside !== undefined) fail(`${dir}/program lists ${outside}, which is not in ${dir}`);
 const bytes = new Map(names.map((name) => [name, read(`${dir}/${name}.wasm`)]));
+// The compiled modules for sessions: the compiled file lists them, each one is in <hash>.subc, and compiled.map holds
+// their module map.
+const compiled = new Map();
+if (fs.existsSync(`${dir}/compiled`)) {
+  const list = read(`${dir}/compiled`);
+  const hashes = list.toString().split(/\r?\n/).filter((l) => l !== '').map((l) => l.slice(0, l.indexOf(' ')));
+  const bad = hashes.find((h) => !/^[0-9a-f]+$/.test(h));
+  if (bad !== undefined) fail(`${dir}/compiled lists ${bad}, which is not a hash`);
+  compiled.set('compiled', list);
+  if (hashes.length > 0) compiled.set('compiled.map', read(`${dir}/compiled.map`));
+  for (const h of hashes) compiled.set(`${h}.subc`, read(`${dir}/${h}.subc`));
+}
 
 // The program process.exec_at_end kept (node/process.mjs).
 const atEnd = () => {
@@ -93,7 +105,7 @@ const host = createHost({
   keyOf: (bytes) => crypto.createHash('sha256').update(bytes).digest('hex'),
 });
 
-const entry = host.load(names, (name) => bytes.get(name));
+const entry = host.load(names, (name) => bytes.get(name), compiled);
 if (!entry) {
   process.stderr.write(`error: ${host.lastError}\n`);
   process.exit(2);

package/substrate/host/web/subhost-web.mjs

@@ -110,7 +110,18 @@ export async function boot(options) {
     for (const bytes of wasm.values()) for (const name of importedModules(bytes)) wanted.add(name);
     modules = await modules(wanted);
   }
-  return run({ ...options, files, modules }, names, wasm);
+  // The compiled modules for sessions: the compiled file lists them, each one is in <hash>.subc, and compiled.map holds
+  // their module map.
+  const compiled = new Map();
+  const listed = await fetch(`${base}compiled`);
+  if (listed.ok) {
+    const list = new Uint8Array(await listed.arrayBuffer());
+    const hashes = text.decode(list).split('\n').filter((l) => l !== '').map((l) => l.slice(0, l.indexOf(' ')));
+    compiled.set('compiled', list);
+    if (hashes.length > 0) compiled.set('compiled.map', await fetchBytes(`${base}compiled.map`));
+    await Promise.all(hashes.map(async (h) => compiled.set(`${h}.subc`, await fetchBytes(`${base}${h}.subc`))));
+  }
+  return run({ ...options, files, modules, compiled }, names, wasm);
 }
 
 export function run(options, names, wasm) {
@@ -157,7 +168,7 @@ export function run(options, names, wasm) {
     return host.call(f, args);
   };
 
-  app.entry = host.load(names, (name) => wasm.get(name));
+  app.entry = host.load(names, (name) => wasm.get(name), options.compiled || null);
   if (!app.entry && options.entry) {
     ended(2, host.lastError);
   } else if (!app.entry) {

package/substrate/host/web/worker-script.mjs

@@ -62,6 +62,7 @@ self.onmessage = async (e) => {
     }
     const app = run({
       args: m.args ?? [m.argument],
+      compiled: m.compiled,
       files: m.files,
       cwd: m.cwd,
       output: side.write,

package/substrate/host/web/worker.mjs

@@ -11,6 +11,7 @@ export function workers() {
       thread.postMessage({
         type: 'start',
         modules: plan.modules,
+        compiled: plan.compiled,
         entry: plan.entry,
         argument: plan.argument,
         files: app.files,

package/substrate/host/worker.mjs

@@ -63,9 +63,11 @@ export function workerModule({ spawn }) {
   function start(entry, argument, time, pages, heard, tag, app, err, grants, setup) {
     const program = caller.program();
     const modules = program.names.map((name) => [name, program.bytes(name)]);
+    const { compiled } = program;
     let thread;
     try {
-      thread = spawn({ modules, entry, argument, grants, names: caller.moduleNames(), pages, heard, ...setup }, app);
+      thread = spawn({ modules, compiled, entry, argument, grants, names: caller.moduleNames(), pages, heard, ...setup },
+                     app);
     } catch (e) {
       caller.fail(err, e.message);
       return 0;