haskell: do-notation desugar + stub IO monad (return/>>=/>>) (+14 tests, 382/382)

Previous version ran all 7 claude sessions in the main working tree on
branch 'architecture'. That would race on git operations and cross-
contaminate commits between languages even though their file scopes
don't overlap. Now each session runs in /root/rose-ash-loops/<lang> on
branch loops/<lang>, created from the current architecture HEAD.

sx-loops-down.sh gains --clean to remove the worktrees; loops/<lang>
branches stay unless explicitly deleted.

Also: second Enter keystroke after the /loop command, since Claude's
input box sometimes interprets the first newline as a soft break.

.gitignore

@@ -23,8 +23,13 @@ hosts/ocaml/test-results/
 shared/static/wasm/sx_browser.bc.wasm.assets/
 .claude/worktrees/
 tests/playwright/test-results/
+test-results/
 test-case-define.sx
 test-case-define.txt
 test_all.js
 test_final.js
 test_interactive.js
+
+# Loop lock/log state
+.loop-locks/
+.loop-logs/

.mcp.json

@@ -8,6 +8,11 @@
       "type": "stdio",
       "command": "python3",
       "args": ["tools/mcp_services.py"]
+    },
+    "hs-test": {
+      "type": "stdio",
+      "command": "python3",
+      "args": ["tools/mcp_hs_test.py"]
     }
   }
 }

applications/graphql/spec.sx

@@ -0,0 +1,64 @@
+
+;; GraphQL — SX language assimilation
+;;
+;; Pure SX implementation of the GraphQL query language.
+;; Parser, executor, and serializer — all s-expressions,
+;; compiled to bytecode by the same kernel.
+;;
+;; Files:
+;;   lib/graphql.sx       — Tokenizer + recursive descent parser
+;;   lib/graphql-exec.sx  — Executor (projection, fragments, variables)
+;;   spec/tests/test-graphql.sx — 66 tests across 15 suites
+;;
+;; Hyperscript integration:
+;;   fetch gql { query { ... } }         — shorthand query
+;;   fetch gql mutation { ... }           — mutation
+;;   fetch gql { ... } from "/endpoint"   — custom endpoint
+;;
+;; Maps to existing SX infrastructure:
+;;   Query       → defquery  (IO suspension)
+;;   Mutation    → defaction (IO suspension)
+;;   Subscription → SSE + signals (reactive islands)
+;;   Fragment    → defcomp   (component composition)
+;;   Schema      → spec/types.sx (gradual type system)
+;;   Resolver    → perform   (CEK IO suspension)
+
+(define graphql-version "0.1.0")
+
+(define
+  graphql-features
+  (quote
+    (queries
+      mutations
+      subscriptions
+      fragments
+      inline-fragments
+      fragment-spreads
+      variables
+      variable-defaults
+      directives
+      directive-arguments
+      aliases
+      field-arguments
+      object-values
+      list-values
+      enum-values
+      block-strings
+      comments
+      field-projection
+      nested-projection
+      list-projection
+      variable-substitution
+      fragment-resolution
+      custom-resolvers
+      default-io-resolver
+      aliased-execution
+      multi-root-fields
+      named-operations
+      operation-introspection
+      ast-to-source
+      round-trip
+      fetch-gql
+      fetch-gql-from
+      fetch-gql-mutation
+      fetch-gql-query)))

hosts/ocaml/bin/dune

@@ -1,6 +1,6 @@
 (executables
  (names run_tests debug_set sx_server integration_tests)
- (libraries sx unix))
+ (libraries sx unix threads.posix otfm yojson))
 
 (executable
  (name mcp_tree)

hosts/ocaml/bootstrap_vm.py

@@ -257,6 +257,7 @@ let closure_code cl = let c = unwrap_closure cl in
   Hashtbl.replace d "vc-bytecode" (List (Array.to_list (Array.map (fun i -> Number (float_of_int i)) c.vm_code.vc_bytecode)));
   Hashtbl.replace d "vc-constants" (List (Array.to_list c.vm_code.vc_constants));
   Hashtbl.replace d "vc-arity" (Number (float_of_int c.vm_code.vc_arity));
+  Hashtbl.replace d "vc-rest-arity" (Number (float_of_int c.vm_code.vc_rest_arity));
   Hashtbl.replace d "vc-locals" (Number (float_of_int c.vm_code.vc_locals));
   Dict d
 
@@ -376,7 +377,7 @@ let vm_create_closure vm_val frame_val code_val =
 
 (* --- JIT sentinel --- *)
 let _jit_failed_sentinel = {
-  vm_code = { vc_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
+  vm_code = { vc_arity = -1; vc_rest_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
               vc_bytecode_list = None; vc_constants_list = None };
   vm_upvalues = [||]; vm_name = Some "__jit_failed__"; vm_env_ref = Hashtbl.create 0; vm_closure_env = None
 }

hosts/ocaml/browser/build-all.sh

@@ -35,4 +35,7 @@ cp -r dist/sx_browser.bc.wasm.assets ./ 2>/dev/null || true
 echo "=== 5. Run WASM tests ==="
 node test_wasm_native.js
 
+echo "=== 6. Run bytecode regression tests ==="
+node test_bytecode_repeat.js
+
 echo "=== Done ==="

hosts/ocaml/browser/bundle.sh

@@ -71,6 +71,11 @@ cp "$ROOT/shared/sx/templates/tw-layout.sx" "$DIST/sx/"
 cp "$ROOT/shared/sx/templates/tw-type.sx"   "$DIST/sx/"
 cp "$ROOT/shared/sx/templates/tw.sx"        "$DIST/sx/"
 
+# 10. Hyperscript
+for f in tokenizer parser compiler runtime integration htmx; do
+  cp "$ROOT/lib/hyperscript/$f.sx" "$DIST/sx/hs-$f.sx"
+done
+
 # Summary
 WASM_SIZE=$(du -sh "$DIST/sx_browser.bc.wasm.assets" | cut -f1)
 JS_SIZE=$(du -sh "$DIST/sx_browser.bc.js" | cut -f1)

hosts/ocaml/browser/compile-modules.js

@@ -47,6 +47,7 @@ const SOURCE_MAP = {
   'engine.sx': 'web/engine.sx', 'orchestration.sx': 'web/orchestration.sx',
   'boot.sx': 'web/boot.sx',
   'tw-layout.sx': 'web/tw-layout.sx', 'tw-type.sx': 'web/tw-type.sx', 'tw.sx': 'web/tw.sx',
+  'text-layout.sx': 'lib/text-layout.sx',
 };
 let synced = 0;
 for (const [dist, src] of Object.entries(SOURCE_MAP)) {
@@ -79,8 +80,13 @@ const FILES = [
   'page-helpers.sx', 'freeze.sx', 'bytecode.sx', 'compiler.sx', 'vm.sx',
   'dom.sx', 'browser.sx', 'adapter-html.sx', 'adapter-sx.sx', 'adapter-dom.sx',
   'tw-layout.sx', 'tw-type.sx', 'tw.sx',
+  'text-layout.sx',
   'boot-helpers.sx', 'hypersx.sx', 'harness.sx', 'harness-reactive.sx',
-  'harness-web.sx', 'engine.sx', 'orchestration.sx', 'boot.sx',
+  'harness-web.sx', 'engine.sx', 'orchestration.sx',
+  // Hyperscript modules — loaded on demand via transparent lazy loader
+  'hs-tokenizer.sx', 'hs-parser.sx', 'hs-compiler.sx', 'hs-runtime.sx',
+  'hs-integration.sx', 'hs-htmx.sx',
+  'boot.sx',
 ];
 
 
@@ -122,36 +128,102 @@ for (const file of FILES) {
 // ---------------------------------------------------------------------------
 
 function stripLibraryWrapper(source) {
-  // Line-based stripping: unwrap (define-library ... (begin BODY)), keep (import ...).
-  const lines = source.split('\n');
-  const result = [];
-  let skip = false;     // inside header region (define-library, export)
+  // Paren-aware stripping: find (begin ...) inside (define-library ...), extract body.
+  // Keep top-level (import ...) forms outside the define-library.
 
-  for (let i = 0; i < lines.length; i++) {
-    const line = lines[i];
-    const trimmed = line.trim();
+  // Find (define-library at the start
+  const dlMatch = source.match(/^[\s\S]*?\(define-library\b/);
+  if (!dlMatch) return source; // no define-library, return as-is
 
-    // Skip (define-library ...) header lines until (begin
-    if (trimmed.startsWith('(define-library ')) { skip = true; continue; }
-    if (skip && trimmed.startsWith('(export')) { continue; }
-    if (skip && trimmed.match(/^\(begin/)) { skip = false; continue; }
-    if (skip) continue;
+  // Find the (begin that opens the body — skip past (export ...) using paren counting
+  const afterDL = dlMatch[0].length;
+  let pos = afterDL;
+  let foundBegin = -1;
 
-    // Skip closing )) of define-library — line is just ) or )) optionally with comments
-    if (trimmed.match(/^\)+(\s*;.*)?$/)) {
-      // Check if this is the end-of-define-library closer (only `)` chars + optional comment)
-      // vs a regular body closer like `    )` inside a nested form
-      // Only skip if at column 0 (not indented = top-level closer)
-      if (line.match(/^\)/)) continue;
+  while (pos < source.length) {
+    // Skip whitespace and comments
+    while (pos < source.length && /[\s]/.test(source[pos])) pos++;
+    if (pos >= source.length) break;
+    if (source[pos] === ';') { // skip comment line
+      while (pos < source.length && source[pos] !== '\n') pos++;
+      continue;
     }
 
-    // Skip standalone comments that are just structural markers
-    if (trimmed.match(/^;;\s*(end define-library|Re-export)/)) continue;
-
-    result.push(line);
+    // Check for (begin
+    if (source.startsWith('(begin', pos)) {
+      foundBegin = pos;
+      break;
     }
 
-  return result.join('\n');
+    // Skip balanced sexp (the library name and export list)
+    if (source[pos] === '(') {
+      let depth = 1;
+      pos++;
+      while (pos < source.length && depth > 0) {
+        if (source[pos] === '(') depth++;
+        else if (source[pos] === ')') depth--;
+        else if (source[pos] === '"') { // skip strings
+          pos++;
+          while (pos < source.length && source[pos] !== '"') {
+            if (source[pos] === '\\') pos++;
+            pos++;
+          }
+        } else if (source[pos] === ';') { // skip comments
+          while (pos < source.length && source[pos] !== '\n') pos++;
+          continue;
+        }
+        pos++;
+      }
+    } else {
+      // Skip atom
+      while (pos < source.length && !/[\s()]/.test(source[pos])) pos++;
+    }
+  }
+
+  if (foundBegin === -1) return source; // no (begin found
+
+  // Find the body inside (begin ...) — skip "(begin" + optional whitespace
+  let bodyStart = foundBegin + 6; // len("(begin") = 6
+  // Skip optional newline/whitespace after (begin
+  while (bodyStart < source.length && /[\s]/.test(source[bodyStart])) bodyStart++;
+
+  // Find matching close of (begin ...) using paren counting from foundBegin
+  pos = foundBegin + 1; // after opening (
+  let depth = 1;
+  while (pos < source.length && depth > 0) {
+    if (source[pos] === '(') depth++;
+    else if (source[pos] === ')') depth--;
+    else if (source[pos] === '"') {
+      pos++;
+      while (pos < source.length && source[pos] !== '"') {
+        if (source[pos] === '\\') pos++;
+        pos++;
+      }
+    } else if (source[pos] === ';') {
+      while (pos < source.length && source[pos] !== '\n') pos++;
+      continue;
+    }
+    if (depth > 0) pos++;
+  }
+  const beginClose = pos; // position of closing ) for (begin ...)
+
+  // Extract body (everything between (begin and its closing paren)
+  const body = source.slice(bodyStart, beginClose);
+
+  // Find any (import ...) forms AFTER the define-library
+  // The define-library's closing paren is right after begin's
+  let dlClose = beginClose + 1;
+  while (dlClose < source.length && source[dlClose] !== ')') {
+    if (source[dlClose] === ';') {
+      while (dlClose < source.length && source[dlClose] !== '\n') dlClose++;
+    }
+    dlClose++;
+  }
+  dlClose++; // past the closing )
+
+  const afterDLForm = source.slice(dlClose);
+
+  return body + '\n' + afterDLForm;
 }
 
 // Compile each module (stripped of define-library/import wrappers)
@@ -339,6 +411,18 @@ function libKey(spec) {
   return spec.replace(/^\(/, '').replace(/\)$/, '');
 }
 
+// Extract top-level (define name ...) symbols from a non-library file
+function extractDefines(source) {
+  const names = [];
+  const re = /^\(define\s+(\S+)/gm;
+  let m;
+  while ((m = re.exec(source)) !== null) {
+    const name = m[1];
+    if (name && !name.startsWith('(') && !name.startsWith(':')) names.push(name);
+  }
+  return names;
+}
+
 const manifest = {};
 let entryFile = null;
 
@@ -360,6 +444,26 @@ for (const file of FILES) {
   } else if (deps.length > 0) {
     // Entry point (no define-library, has imports)
     entryFile = { file: sxbcFile, deps: deps.map(libKey) };
+  } else {
+    // Non-library file (e.g. hyperscript modules) — extract top-level defines
+    // as exports so the transparent lazy loader can resolve symbols to files.
+    const defines = extractDefines(src);
+    if (defines.length > 0) {
+      const key = file.replace(/\.sx$/, '');
+      // HS modules form a dependency chain — loading one loads all predecessors.
+      const HS_DEPS = {
+        'hs-parser': ['hs-tokenizer'],
+        'hs-compiler': ['hs-tokenizer', 'hs-parser'],
+        'hs-runtime': ['hs-tokenizer', 'hs-parser', 'hs-compiler'],
+        'hs-integration': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime'],
+        'hs-htmx': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-integration'],
+      };
+      manifest[key] = {
+        file: sxbcFile,
+        deps: HS_DEPS[key] || [],
+        exports: defines,
+      };
+    }
   }
 }
 
@@ -371,6 +475,16 @@ if (entryFile) {
   ]);
   const eagerDeps = entryFile.deps.filter(d => !LAZY_ENTRY_DEPS.has(d));
   const lazyDeps = entryFile.deps.filter(d => LAZY_ENTRY_DEPS.has(d));
+  // Hyperscript modules aren't define-library, so not auto-detected as deps.
+  // Load them lazily after boot — eager loading breaks the boot sequence.
+  const HS_LAZY = ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-integration', 'hs-htmx'];
+  for (const m of HS_LAZY) {
+    if (manifest[m] && !lazyDeps.includes(m)) lazyDeps.push(m);
+  }
+  // Text layout library — loaded eagerly for Pretext island
+  if (manifest['sx text-layout'] && !eagerDeps.includes('sx text-layout')) {
+    eagerDeps.push('sx text-layout');
+  }
   manifest['_entry'] = {
     file: entryFile.file,
     deps: eagerDeps,

hosts/ocaml/browser/sx-platform.js

@@ -40,7 +40,12 @@
     var obj = args[0], prop = args[1];
     if (obj == null) return null;
     var v = obj[prop];
-    return v === undefined ? null : v;
+    if (v === undefined) return null;
+    // Functions can't cross the WASM boundary — return true as a truthy
+    // sentinel so (host-get el "getAttribute") works as a guard.
+    // Use host-call to actually invoke the method.
+    if (typeof v === "function") return true;
+    return v;
   });
 
   K.registerNative("host-set!", function(args) {
@@ -79,16 +84,87 @@
     }
   });
 
+  // IO suspension driver — resumes suspended callFn results (wait, fetch, etc.)
+  if (!window._driveAsync) {
+    window._driveAsync = function driveAsync(result) {
+      if (!result || !result.suspended) return;
+      var req = result.request;
+      var items = req && (req.items || req);
+      var op = items && items[0];
+      var opName = typeof op === "string" ? op : (op && op.name) || String(op);
+      var arg = items && items[1];
+      if (opName === "io-sleep" || opName === "wait") {
+        setTimeout(function() {
+          try { driveAsync(result.resume(null)); } catch(e) { console.error("[sx] driveAsync:", e.message); }
+        }, typeof arg === "number" ? arg : 0);
+      } else if (opName === "io-fetch") {
+        var fetchUrl = typeof arg === "string" ? arg : "";
+        var fetchMethod = (items && items[2]) || "GET";
+        var fetchBody = items && items[3];
+        var fetchHeaders = items && items[4];
+        var fetchOpts = { method: typeof fetchMethod === "string" ? fetchMethod : "GET" };
+        if (fetchBody && typeof fetchBody !== "boolean") {
+          fetchOpts.body = typeof fetchBody === "string" ? fetchBody : JSON.stringify(fetchBody);
+        }
+        if (fetchHeaders && typeof fetchHeaders === "object") {
+          var h = {};
+          var keys = fetchHeaders._keys || Object.keys(fetchHeaders);
+          for (var fi = 0; fi < keys.length; fi++) {
+            var k = keys[fi], v = fetchHeaders[k];
+            if (typeof k === "string" && typeof v === "string") h[k] = v;
+          }
+          fetchOpts.headers = h;
+        }
+        fetch(fetchUrl, fetchOpts).then(function(r) {
+          var hdrs = {};
+          try { r.headers.forEach(function(v, k) { hdrs[k] = v; }); } catch(e) {}
+          return r.text().then(function(t) {
+            return { status: r.status, body: t, headers: hdrs, ok: r.ok };
+          });
+        }).then(function(resp) {
+          try { driveAsync(result.resume(resp)); } catch(e) { console.error("[sx] driveAsync:", e.message); }
+        }).catch(function(e) {
+          try { driveAsync(result.resume({status: 0, body: "", headers: {}, ok: false})); } catch(e2) { console.error("[sx] driveAsync:", e2.message); }
+        });
+      } else if (opName === "io-navigate") {
+        // navigation — don't resume
+      } else if (opName === "text-measure") {
+        // Pretext: measure text using offscreen canvas
+        var font = arg;
+        var size = items && items[2];
+        var text = items && items[3];
+        var canvas = document.createElement("canvas");
+        var ctx = canvas.getContext("2d");
+        ctx.font = (size || 16) + "px " + (font || "serif");
+        var m = ctx.measureText(text || "");
+        try {
+          driveAsync(result.resume({
+            width: m.width,
+            height: m.actualBoundingBoxAscent + m.actualBoundingBoxDescent,
+            ascent: m.actualBoundingBoxAscent,
+            descent: m.actualBoundingBoxDescent
+          }));
+        } catch(e) { console.error("[sx] driveAsync:", e.message); }
+      } else {
+        console.warn("[sx] unhandled IO:", opName);
+      }
+    };
+  }
+
   K.registerNative("host-callback", function(args) {
     var fn = args[0];
     // Native JS function — pass through
     if (typeof fn === "function") return fn;
     // SX callable (has __sx_handle) — wrap as JS function
     if (fn && fn.__sx_handle !== undefined) {
-      return function() {
+      var wrappedFn = function() {
         var a = Array.prototype.slice.call(arguments);
-        return K.callFn(fn, a);
+        var r = K.callFn(fn, a);
+        if (window._driveAsync) window._driveAsync(r);
+        return r;
       };
+      wrappedFn.__host_callback = true;
+      return wrappedFn;
     }
     return function() {};
   });
@@ -223,6 +299,11 @@
           break;
         }
       }
+      // Content-addressed boot: script loaded from /sx/h/{hash}, not /static/wasm/.
+      // Fall back to /static/wasm/ base URL for module-manifest.sx and .sx sources.
+      if (!_baseUrl || _baseUrl.indexOf("/sx/h/") !== -1) {
+        _baseUrl = "/static/wasm/";
+      }
     }
   })();
 
@@ -301,19 +382,56 @@
   /**
    * Try loading a pre-compiled .sxbc bytecode module (SX text format).
    * Uses K.loadModule which handles VM suspension (import requests).
+   * Content-addressed: checks localStorage by hash, fetches /sx/h/{hash} on miss.
    * Returns true on success, null on failure (caller falls back to .sx source).
    */
   function loadBytecodeFile(path) {
     var sxbcPath = path.replace(/\.sx$/, '.sxbc');
+    var sxbcFile = sxbcPath.split('/').pop(); // e.g. "dom.sxbc"
+
+    // Content-addressed resolution: manifest → localStorage → fetch by hash
+    var text = null;
+    var manifest = loadPageManifest();
+    if (manifest && manifest.modules && manifest.modules[sxbcFile]) {
+      var hash = manifest.modules[sxbcFile];
+      var lsKey = "sx:h:" + hash;
+      try {
+        text = localStorage.getItem(lsKey);
+      } catch(e) {}
+      if (!text) {
+        // Fetch by content hash
+        try {
+          var xhr2 = new XMLHttpRequest();
+          xhr2.open("GET", "/sx/h/" + hash, false);
+          xhr2.send();
+          if (xhr2.status === 200) {
+            text = xhr2.responseText;
+            // Strip comment line if present
+            if (text.charAt(0) === ';') {
+              var nl = text.indexOf('\n');
+              if (nl >= 0) text = text.substring(nl + 1);
+            }
+            try { localStorage.setItem(lsKey, text); } catch(e) {}
+          }
+        } catch(e) {}
+      }
+    }
+
+    // Fallback: fetch by URL (pre-content-addressed path)
+    if (!text) {
       var url = _baseUrl + sxbcPath + _sxbcCacheBust;
       try {
         var xhr = new XMLHttpRequest();
         xhr.open("GET", url, false);
         xhr.send();
         if (xhr.status !== 200) return null;
+        text = xhr.responseText;
+      } catch(e) { return null; }
+    }
 
+    try {
       // Parse the sxbc text to get the SX tree
-      var parsed = K.parse(xhr.responseText);
+      var parsed = K.parse(text);
       if (!parsed || !parsed.length) return null;
       var sxbc = parsed[0]; // (sxbc version hash (code ...))
       if (!sxbc || sxbc._type !== "list" || !sxbc.items) return null;
@@ -431,6 +549,22 @@
   var _manifest = null;
   var _loadedLibs = {};
 
+  /**
+   * Convert K.parse output (tagged {_type, ...} objects) to plain JS.
+   * SX nil (from empty lists `()`) becomes [].
+   */
+  function sxDataToJs(v) {
+    if (v === null || v === undefined) return [];
+    if (typeof v !== "object") return v;
+    if (v._type === "list") return (v.items || []).map(sxDataToJs);
+    if (v._type === "dict") {
+      var out = {};
+      for (var k in v) if (k !== "_type") out[k] = sxDataToJs(v[k]);
+      return out;
+    }
+    return v;
+  }
+
   /**
    * Fetch and parse the module manifest (library deps + file paths).
    */
@@ -438,12 +572,15 @@
     if (_manifest) return _manifest;
     try {
       var xhr = new XMLHttpRequest();
-      xhr.open("GET", _baseUrl + "sx/module-manifest.json" + _cacheBust, false);
+      xhr.open("GET", _baseUrl + "sx/module-manifest.sx" + _cacheBust, false);
       xhr.send();
       if (xhr.status === 200) {
-        _manifest = JSON.parse(xhr.responseText);
+        var parsed = K.parse(xhr.responseText);
+        if (parsed && parsed.length > 0) {
+          _manifest = sxDataToJs(parsed[0]);
           return _manifest;
         }
+      }
     } catch(e) {}
     console.warn("[sx-platform] No manifest found, falling back to full load");
     return null;
@@ -474,7 +611,7 @@
     // will see it as already loaded and skip rather than infinite-looping.
     _loadedLibs[name] = true;
 
-    // Load this module
+    // Load this module (bytecode first, fallback to source)
     var ok = loadBytecodeFile("sx/" + info.file);
     if (!ok) {
       var sxFile = info.file.replace(/\.sxbc$/, '.sx');
@@ -577,10 +714,201 @@
     return _symbolIndex;
   }
 
+  // ================================================================
+  // Content-addressed definition loader
+  //
+  // The page manifest maps component names to content hashes.
+  // When a ~component symbol is missing, we resolve its hash,
+  // check localStorage, fetch from /sx/h/{hash} if needed,
+  // then load the definition (recursively resolving @h: deps).
+  // ================================================================
+
+  var _pageManifest = null;   // { defs: { "~name": "hash", ... } }
+  var _hashToName = {};       // hash → "~name"
+  var _hashCache = {};        // hash → definition text (in-memory)
+  var _loadedHashes = {};     // hash → true (already K.load'd)
+
+  function loadPageManifest() {
+    if (_pageManifest) return _pageManifest;
+    var el = document.querySelector('script[data-sx-manifest]');
+    if (!el) return null;
+    try {
+      _pageManifest = JSON.parse(el.textContent);
+      var defs = _pageManifest.defs || {};
+      for (var name in defs) {
+        _hashToName[defs[name]] = name;
+      }
+      return _pageManifest;
+    } catch(e) {
+      console.warn("[sx] Failed to parse manifest:", e);
+      return null;
+    }
+  }
+
+  // Merge definitions from a new page's manifest (called during navigation)
+  function mergeManifest(el) {
+    if (!el) return;
+    try {
+      var incoming = JSON.parse(el.textContent);
+      var newDefs = incoming.defs || {};
+      // Ensure base manifest is loaded
+      if (!_pageManifest) loadPageManifest();
+      if (!_pageManifest) _pageManifest = { defs: {} };
+      if (!_pageManifest.defs) _pageManifest.defs = {};
+      for (var name in newDefs) {
+        _pageManifest.defs[name] = newDefs[name];
+        _hashToName[newDefs[name]] = name;
+      }
+      // Merge hash store entries
+      if (incoming.store) {
+        if (!_pageManifest.store) _pageManifest.store = {};
+        for (var h in incoming.store) {
+          _pageManifest.store[h] = incoming.store[h];
+        }
+      }
+    } catch(e) {
+      console.warn("[sx] Failed to merge manifest:", e);
+    }
+  }
+
+  function resolveHash(hash) {
+    // 1. In-memory cache
+    if (_hashCache[hash]) return _hashCache[hash];
+    // 2. localStorage
+    var key = "sx:h:" + hash;
+    try {
+      var cached = localStorage.getItem(key);
+      if (cached) {
+        _hashCache[hash] = cached;
+        return cached;
+      }
+    } catch(e) {}
+    // 3. Fetch from server
+    try {
+      var xhr = new XMLHttpRequest();
+      xhr.open("GET", "/sx/h/" + hash, false);
+      xhr.send();
+      if (xhr.status === 200) {
+        var def = xhr.responseText;
+        _hashCache[hash] = def;
+        try { localStorage.setItem(key, def); } catch(e) {}
+        return def;
+      }
+    } catch(e) {
+      console.warn("[sx] Failed to fetch hash " + hash + ":", e);
+    }
+    return null;
+  }
+
+  function loadDefinitionByHash(hash) {
+    if (_loadedHashes[hash]) return true;
+    // Mark in-progress immediately to prevent circular recursion
+    _loadedHashes[hash] = "loading";
+    var def = resolveHash(hash);
+    if (!def) { delete _loadedHashes[hash]; return false; }
+
+    // Strip comment line (;; ~name\n) from start
+    var src = def;
+    if (src.charAt(0) === ';') {
+      var nl = src.indexOf('\n');
+      if (nl >= 0) src = src.substring(nl + 1);
+    }
+
+    // Find and recursively load @h: dependencies before loading this one
+    var hashRe = /@h:([0-9a-f]{16})/g;
+    var match;
+    while ((match = hashRe.exec(src)) !== null) {
+      var depHash = match[1];
+      if (!_loadedHashes[depHash]) {
+        loadDefinitionByHash(depHash);
+      }
+    }
+
+    // Rewrite @h:xxx back to ~names for the SX evaluator
+    var rewritten = src.replace(/@h:([0-9a-f]{16})/g, function(_m, h) {
+      return _hashToName[h] || ("@h:" + h);
+    });
+
+    // Eagerly pre-load any plain manifest symbols referenced in this definition.
+    // The CEK evaluator doesn't call __resolve-symbol, so deps must be present
+    // before the definition is called. Scan for word boundaries matching manifest keys.
+    if (_pageManifest && _pageManifest.defs) {
+      var words = rewritten.match(/[a-zA-Z_][a-zA-Z0-9_?!-]*/g) || [];
+      for (var wi = 0; wi < words.length; wi++) {
+        var w = words[wi];
+        if (w !== name && _pageManifest.defs[w] && !_loadedHashes[_pageManifest.defs[w]]) {
+          loadDefinitionByHash(_pageManifest.defs[w]);
+        }
+      }
+    }
+
+    // Prepend the component name back into the definition.
+    // Only for single-definition forms (defcomp/defisland/defmacro) where
+    // the name was stripped for hashing. Multi-define files (client libs)
+    // already contain named (define name ...) forms.
+    var name = _hashToName[hash];
+    if (name) {
+      // Check if this is a multi-define file (client lib with top-level defines).
+      // Only top-level (define ...) forms count — nested ones inside defisland/defcomp
+      // bodies should NOT suppress name insertion.
+      var startsWithDef = /^\((defcomp|defisland|defmacro)\s/.test(rewritten);
+      var isMultiDefine = !startsWithDef && /\(define\s+[a-zA-Z]/.test(rewritten);
+      if (!isMultiDefine) {
+        rewritten = rewritten.replace(
+          /^\((defcomp|defisland|defmacro|define)\s/,
+          function(_m, kw) { return "(" + kw + " " + name + " "; }
+        );
+      }
+    }
+
+    try {
+      var loadRv = K.load(rewritten);
+      if (typeof loadRv === "string" && loadRv.indexOf("Error") >= 0) {
+        console.warn("[sx] K.load error for", (_hashToName[hash] || hash) + ":", loadRv);
+        delete _loadedHashes[hash];
+        return false;
+      }
+      _loadedHashes[hash] = true;
+      return true;
+    } catch(e) {
+      console.warn("[sx] Failed to load hash " + hash + " (" + (name || "?") + "):", e);
+      return false;
+    }
+  }
+
+  // Eagerly pre-load island definitions from the manifest.
+  // Called from boot.sx before hydration. Scans the DOM for data-sx-island
+  // attributes and loads definitions via the content-addressed manifest.
+  // Unlike __resolve-symbol (called from inside env_get), this runs at the
+  // top level so K.load can register bindings without reentrancy issues.
+  K.registerNative("preload-island-defs", function() {
+    var manifest = loadPageManifest();
+    if (!manifest || !manifest.defs) return null;
+    var els = document.querySelectorAll('[data-sx-island]');
+    for (var i = 0; i < els.length; i++) {
+      var name = "~" + els[i].getAttribute("data-sx-island");
+      if (manifest.defs[name] && !_loadedHashes[manifest.defs[name]]) {
+        loadDefinitionByHash(manifest.defs[name]);
+      }
+    }
+    return null;
+  });
+
   // Register the resolve hook — called by the VM when GLOBAL_GET fails
   K.registerNative("__resolve-symbol", function(args) {
     var name = args[0];
     if (!name) return null;
+    // Content-addressed resolution — components, libraries, macros
+    var manifest = loadPageManifest();
+    if (manifest && manifest.defs && manifest.defs[name]) {
+      var hash = manifest.defs[name];
+      if (!_loadedHashes[hash]) {
+        loadDefinitionByHash(hash);
+        return null;  // VM re-lookups after hook
+      }
+    }
+
+    // Library-level resolution (existing path — .sxbc modules)
     var idx = buildSymbolIndex();
     if (!idx || !idx[name]) return null;
     var lib = idx[name];
@@ -603,6 +931,7 @@
     renderToHtml: function(expr) { return K.renderToHtml(expr); },
     callFn: function(fn, args) { return K.callFn(fn, args); },
     engine: function() { return K.engine(); },
+    mergeManifest: function(el) { return mergeManifest(el); },
     // Boot entry point (called by auto-init or manually)
     init: function() {
       if (typeof K.eval === "function") {
@@ -617,6 +946,20 @@
         K.eval("(process-sx-scripts nil)");
         console.log("[sx] sx-hydrate-elements...");
         K.eval("(sx-hydrate-elements nil)");
+        // Pre-load island definitions from manifest before hydration.
+        // Must happen at JS level (not from inside SX eval) to avoid
+        // K.load reentrancy issues with the symbol resolve hook.
+        var manifest = loadPageManifest();
+        if (manifest && manifest.defs) {
+          var islandEls = document.querySelectorAll("[data-sx-island]");
+          for (var ii = 0; ii < islandEls.length; ii++) {
+            var iname = "~" + islandEls[ii].getAttribute("data-sx-island");
+            var ihash = manifest.defs[iname];
+            if (ihash && !_loadedHashes[ihash]) {
+              loadDefinitionByHash(ihash);
+            }
+          }
+        }
         console.log("[sx] sx-hydrate-islands...");
         K.eval("(sx-hydrate-islands nil)");
         console.log("[sx] process-elements...");
@@ -650,6 +993,20 @@
           var scrollY = (state && state.scrollY) ? state.scrollY : 0;
           K.eval("(handle-popstate " + scrollY + ")");
         });
+        // Wire up streaming suspense resolution
+        var _resolveFn = K.eval("resolve-suspense");
+        Sx.resolveSuspense = function(id, sx) {
+          try { K.callFn(_resolveFn, [id, sx]); }
+          catch(e) { console.error("[sx] resolveSuspense error:", e); }
+        };
+        // Drain any pending resolves that arrived before boot
+        if (window.__sxPending) {
+          for (var pi = 0; pi < window.__sxPending.length; pi++) {
+            Sx.resolveSuspense(window.__sxPending[pi].id, window.__sxPending[pi].sx);
+          }
+          window.__sxPending = null;
+        }
+        window.__sxResolve = function(id, sx) { Sx.resolveSuspense(id, sx); };
         // Signal boot complete
         document.documentElement.setAttribute("data-sx-ready", "true");
         console.log("[sx] boot done");

hosts/ocaml/browser/sx_browser.ml

@@ -108,6 +108,50 @@ let rec value_to_js (v : value) : Js.Unsafe.any =
         let result = call_sx_fn v args in
         value_to_js result
       with
+      | Sx_vm.VmSuspended (request, vm) ->
+        (* Transfer reuse_stack from the active VM to the suspension VM.
+           call_closure_reuse saves caller frames on _active_vm AFTER the
+           inner VmSuspended propagates, so the suspension VM doesn't have them. *)
+        (match !Sx_vm._active_vm with
+         | Some active when active.Sx_vm.reuse_stack <> [] ->
+           vm.Sx_vm.reuse_stack <- vm.Sx_vm.reuse_stack @ active.Sx_vm.reuse_stack;
+           active.Sx_vm.reuse_stack <- []
+         | _ -> ());
+        (* Build {suspended, request, resume} and hand to _driveAsync.
+           The resume callback must also catch VmSuspended for chaining
+           (e.g. repeat 3 times ... wait ... end). *)
+        let rec make_suspension req v =
+          let obj = Js.Unsafe.obj [||] in
+          Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject Js._true);
+          Js.Unsafe.set obj (Js.string "request") (value_to_js req);
+          Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun result_js ->
+            let result = js_to_value result_js in
+            try value_to_js (Sx_vm.resume_vm v result)
+            with
+            | Sx_vm.VmSuspended (req2, vm2) ->
+              (* Return suspension object — the JS driveAsync caller handles scheduling *)
+              Js.Unsafe.inject (make_suspension req2 vm2)
+            | Eval_error msg ->
+              (* Enhanced error: show pending_cek kont, reuse_stack, and VM frame info *)
+              let vm_frame_names = String.concat "," (List.map (fun f ->
+                match f.Sx_vm.closure.Sx_types.vm_name with Some n -> n | None -> "?"
+              ) v.Sx_vm.frames) in
+              let extra = Printf.sprintf " [vm: pending_cek=%b reuse=%d frames=[%s] sp=%d]"
+                (v.Sx_vm.pending_cek <> None)
+                (List.length v.Sx_vm.reuse_stack)
+                vm_frame_names
+                v.Sx_vm.sp in
+              ignore (Js.Unsafe.meth_call
+                (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
+                "error" [| Js.Unsafe.inject (Js.string ("[sx] resume: " ^ msg ^ extra)) |]);
+              Js.Unsafe.inject Js.null));
+          obj
+        in
+        let s = make_suspension request vm in
+        let drive = Js.Unsafe.get Js.Unsafe.global (Js.string "_driveAsync") in
+        if not (Js.Unsafe.equals drive Js.undefined) then
+          ignore (Js.Unsafe.fun_call drive [| Js.Unsafe.inject s |]);
+        Js.Unsafe.inject s
       | Eval_error msg ->
         let fn_info = Printf.sprintf " [callback %s handle=%d]" (type_of v) handle in
         ignore (Js.Unsafe.meth_call
@@ -141,13 +185,18 @@ and js_to_value (js : Js.Unsafe.any) : value =
     | "string" -> String (Js.to_string (Js.Unsafe.coerce js))
     | "function" ->
       let h = Js.Unsafe.get js (Js.string "__sx_handle") in
-      if not (Js.Unsafe.equals h Js.undefined) then
+      let has_host_cb = Js.to_bool (Js.Unsafe.coerce (Js.Unsafe.get js (Js.string "__host_callback"))) in
+      if not (Js.Unsafe.equals h Js.undefined) && not has_host_cb then
         get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
       else
-        (* Plain JS function — wrap as NativeFn *)
-        NativeFn ("js-callback", fun args ->
-          let js_args = args |> List.map value_to_js |> Array.of_list in
-          js_to_value (Js.Unsafe.fun_call js (Array.map Fun.id js_args)))
+        (* Plain JS function — store as host object so value_to_js
+           returns the ORIGINAL JS function when passed to host-call.
+           This preserves wrappers like _driveAsync that host-callback
+           attaches for IO suspension handling. *)
+        let id = host_put js in
+        let d = Hashtbl.create 2 in
+        Hashtbl.replace d "__host_handle" (Number (float_of_int id));
+        Dict d
     | "object" ->
       let h = Js.Unsafe.get js (Js.string "__sx_handle") in
       if not (Js.Unsafe.equals h Js.undefined) then
@@ -205,6 +254,7 @@ let return_via_side_channel (v : Js.Unsafe.any) : Js.Unsafe.any =
    VmClosures from bytecode modules hold vm_env_ref pointing here.
    Must stay in sync so VmClosures see post-boot definitions. *)
 let _vm_globals : (string, value) Hashtbl.t = Hashtbl.create 512
+let () = Sx_types._default_vm_globals := _vm_globals
 let _in_batch = ref false
 
 (* Sync env→VM: copy all bindings from global_env.bindings to _vm_globals.
@@ -242,7 +292,9 @@ let () =
       (* Check if the symbol appeared in globals after the load *)
       match Hashtbl.find_opt _vm_globals name with
       | Some v -> Some v
-      | None -> None)
+      | None ->
+        (* Fallback: check global_env directly if vm_globals missed the sync *)
+        Hashtbl.find_opt global_env.bindings (Sx_types.intern name))
 
 (* ================================================================== *)
 (* Core API                                                            *)
@@ -487,22 +539,58 @@ let api_register_native name_js callback_js =
   Hashtbl.replace _vm_globals name v;
   Js.Unsafe.inject Js.null
 
+let rec make_js_callFn_suspension request vm =
+  let obj = Js.Unsafe.obj [||] in
+  Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject Js._true);
+  Js.Unsafe.set obj (Js.string "request") (value_to_js request);
+  Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun result_js ->
+    let result = js_to_value result_js in
+    try
+      let v = Sx_vm.resume_vm vm result in
+      sync_vm_to_env ();
+      value_to_js v
+    with
+    | Sx_vm.VmSuspended (req2, vm2) ->
+      Js.Unsafe.inject (make_js_callFn_suspension req2 vm2)
+    | Eval_error msg ->
+      let vm_frame_names = String.concat "," (List.map (fun f ->
+        match f.Sx_vm.closure.Sx_types.vm_name with Some n -> n | None -> "?"
+      ) vm.Sx_vm.frames) in
+      let extra = Printf.sprintf " [vm: pending_cek=%b reuse=%d frames=[%s] sp=%d]"
+        (vm.Sx_vm.pending_cek <> None)
+        (List.length vm.Sx_vm.reuse_stack)
+        vm_frame_names
+        vm.Sx_vm.sp in
+      ignore (Js.Unsafe.meth_call
+        (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
+        "error" [| Js.Unsafe.inject (Js.string ("[sx] resume: " ^ msg ^ extra)) |]);
+      Js.Unsafe.inject Js.null));
+  obj
+
 let api_call_fn fn_js args_js =
   try
     let fn = js_to_value fn_js in
     let args = Array.to_list (Array.map js_to_value (Js.to_array (Js.Unsafe.coerce args_js))) in
     return_via_side_channel (value_to_js (call_sx_fn fn args))
   with
+  | Sx_vm.VmSuspended (request, vm) ->
+    (* Transfer reuse_stack from active VM *)
+    (match !Sx_vm._active_vm with
+     | Some active when active.Sx_vm.reuse_stack <> [] ->
+       vm.Sx_vm.reuse_stack <- vm.Sx_vm.reuse_stack @ active.Sx_vm.reuse_stack;
+       active.Sx_vm.reuse_stack <- []
+     | _ -> ());
+    sync_vm_to_env ();
+    Js.Unsafe.inject (make_js_callFn_suspension request vm)
   | Eval_error msg ->
-    ignore (Js.Unsafe.meth_call
-      (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
-      "error" [| Js.Unsafe.inject (Js.string ("[sx] callFn: " ^ msg)) |]);
-    Js.Unsafe.inject Js.null
+    (* Store the error message so callers can detect it *)
+    let err_obj = Js.Unsafe.obj [| ("__sx_error", Js.Unsafe.inject Js._true);
+                                    ("message", Js.Unsafe.inject (Js.string msg)) |] in
+    Js.Unsafe.inject err_obj
   | exn ->
-    ignore (Js.Unsafe.meth_call
-      (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
-      "error" [| Js.Unsafe.inject (Js.string ("[sx] callFn: " ^ Printexc.to_string exn)) |]);
-    Js.Unsafe.inject Js.null
+    let err_obj = Js.Unsafe.obj [| ("__sx_error", Js.Unsafe.inject Js._true);
+                                    ("message", Js.Unsafe.inject (Js.string (Printexc.to_string exn))) |] in
+    Js.Unsafe.inject err_obj
 
 let api_is_callable fn_js =
   if Js.Unsafe.equals fn_js Js.null || Js.Unsafe.equals fn_js Js.undefined then
@@ -635,7 +723,14 @@ let () =
       in
       let module_val = convert_code code_form in
       let code = Sx_vm.code_from_value module_val in
-      let _result = Sx_vm.execute_module code _vm_globals in
+      (* Use execute_module_safe to handle import suspension.
+         Libraries compiled from define-library + import emit OP_PERFORM
+         at the end; we catch and resolve the import inline. *)
+      (try
+        ignore (Sx_vm.execute_module code _vm_globals)
+       with
+       | Sx_vm.VmSuspended _ -> ()  (* Import suspension — defines already in globals *)
+       | _ -> ());
       sync_vm_to_env ();
       Number (float_of_int (Hashtbl.length _vm_globals))
     | _ -> raise (Eval_error "load-sxbc: expected (sxbc version hash (code ...))"));
@@ -992,4 +1087,16 @@ let () =
     let log = Sx_primitives.scope_trace_drain () in
     Js.Unsafe.inject (Js.array (Array.of_list (List.map (fun s -> Js.Unsafe.inject (Js.string s)) log)))));
 
+  (* Step limit for timeout protection *)
+  Js.Unsafe.set sx (Js.string "setStepLimit") (Js.wrap_callback (fun n ->
+    let limit = Js.float_of_number (Js.Unsafe.coerce n) |> int_of_float in
+    Sx_ref.step_limit := limit;
+    Sx_ref.step_count := 0;
+    Sx_vm.vm_reset_counters ();
+    Js.Unsafe.inject Js.null));
+  Js.Unsafe.set sx (Js.string "resetStepCount") (Js.wrap_callback (fun () ->
+    Sx_ref.step_count := 0;
+    Sx_vm.vm_reset_counters ();
+    Js.Unsafe.inject Js.null));
+
   Js.Unsafe.set Js.Unsafe.global (Js.string "SxKernel") sx

hosts/ocaml/browser/test_bytecode_repeat.js

@@ -0,0 +1,230 @@
+#!/usr/bin/env node
+// test_bytecode_repeat.js — Regression test for bytecode when/do/perform bug
+//
+// Tests that (when cond (do (perform ...) (recurse))) correctly resumes
+// the do continuation after perform/cek_resume in bytecode-compiled code.
+//
+// The bug: bytecode-compiled hs-repeat-times only iterates 2x instead of 3x
+// because the do continuation is lost after perform suspension.
+//
+// Source-loaded code works (CEK handles when/do/perform correctly).
+// Bytecode-compiled code fails (VM/CEK handoff loses the continuation).
+//
+// Usage: node hosts/ocaml/browser/test_bytecode_repeat.js
+//
+// Expected output when bug is fixed:
+//   SOURCE:   6 suspensions (3 iterations × 2 waits) ✓
+//   BYTECODE: 6 suspensions (3 iterations × 2 waits) ✓
+
+const fs = require('fs');
+const path = require('path');
+
+const PROJECT_ROOT = path.resolve(__dirname, '../../..');
+const WASM_DIR = path.join(PROJECT_ROOT, 'shared/static/wasm');
+const SX_DIR = path.join(WASM_DIR, 'sx');
+
+// --- Minimal DOM stubs ---
+function makeElement(tag) {
+  const el = {
+    tagName: tag, _attrs: {}, _classes: new Set(), style: {},
+    childNodes: [], children: [], textContent: '', nodeType: 1,
+    classList: {
+      add(c) { el._classes.add(c); },
+      remove(c) { el._classes.delete(c); },
+      contains(c) { return el._classes.has(c); },
+    },
+    setAttribute(k, v) { el._attrs[k] = String(v); },
+    getAttribute(k) { return el._attrs[k] || null; },
+    removeAttribute(k) { delete el._attrs[k]; },
+    appendChild(c) { el.children.push(c); el.childNodes.push(c); return c; },
+    insertBefore(c) { el.children.push(c); el.childNodes.push(c); return c; },
+    removeChild(c) { return c; }, replaceChild(n) { return n; },
+    cloneNode() { return makeElement(tag); },
+    addEventListener() {}, removeEventListener() {}, dispatchEvent() {},
+    get className() { return [...el._classes].join(' '); },
+    get innerHTML() { return ''; }, set innerHTML(v) {},
+    get outerHTML() { return '<' + tag + '>'; },
+    dataset: {}, querySelectorAll() { return []; }, querySelector() { return null; },
+  };
+  return el;
+}
+
+global.window = global;
+global.document = {
+  createElement: makeElement,
+  createDocumentFragment() { return makeElement('fragment'); },
+  head: makeElement('head'), body: makeElement('body'),
+  querySelector() { return null; }, querySelectorAll() { return []; },
+  createTextNode(s) { return { _isText: true, textContent: String(s), nodeType: 3 }; },
+  addEventListener() {},
+  createComment(s) { return { _isComment: true, textContent: s || '', nodeType: 8 }; },
+  getElementsByTagName() { return []; },
+};
+global.localStorage = { getItem() { return null; }, setItem() {}, removeItem() {} };
+global.CustomEvent = class { constructor(n, o) { this.type = n; this.detail = (o || {}).detail || {}; } };
+global.MutationObserver = class { observe() {} disconnect() {} };
+global.requestIdleCallback = fn => setTimeout(fn, 0);
+global.matchMedia = () => ({ matches: false });
+global.navigator = { serviceWorker: { register() { return Promise.resolve(); } } };
+global.location = { href: '', pathname: '/', hostname: 'localhost' };
+global.history = { pushState() {}, replaceState() {} };
+global.fetch = () => Promise.resolve({ ok: true, text() { return Promise.resolve(''); } });
+global.XMLHttpRequest = class { open() {} send() {} };
+
+async function main() {
+  // Load WASM kernel
+  require(path.join(WASM_DIR, 'sx_browser.bc.js'));
+  const K = globalThis.SxKernel;
+  if (!K) { console.error('FATAL: SxKernel not found'); process.exit(1); }
+
+  // Register FFI
+  K.registerNative('host-global', args => (args[0] in globalThis) ? globalThis[args[0]] : null);
+  K.registerNative('host-get', args => { if (args[0] == null) return null; const v = args[0][args[1]]; return v === undefined ? null : v; });
+  K.registerNative('host-set!', args => { if (args[0] != null) args[0][args[1]] = args[2]; return args[2]; });
+  K.registerNative('host-call', args => {
+    const [obj, method, ...rest] = args;
+    if (obj == null || typeof obj[method] !== 'function') return null;
+    return obj[method].apply(obj, rest) ?? null;
+  });
+  K.registerNative('host-new', args => new (Function.prototype.bind.apply(args[0], [null, ...args.slice(1)])));
+  K.registerNative('host-callback', args => {
+    const fn = args[0];
+    return function() { return K.callFn(fn, Array.from(arguments)); };
+  });
+  K.registerNative('host-typeof', args => typeof args[0]);
+  K.registerNative('host-await', args => args[0]);
+
+  K.eval('(define SX_VERSION "test-bc-repeat")');
+  K.eval('(define SX_ENGINE "ocaml-vm-test")');
+  K.eval('(define parse sx-parse)');
+  K.eval('(define serialize sx-serialize)');
+
+  // DOM stubs for HS runtime
+  K.eval('(define dom-add-class (fn (el cls) (host-call (host-get el "classList") "add" cls)))');
+  K.eval('(define dom-remove-class (fn (el cls) (host-call (host-get el "classList") "remove" cls)))');
+  K.eval('(define dom-has-class? (fn (el cls) (host-call (host-get el "classList") "contains" cls)))');
+  K.eval('(define dom-listen (fn (target event-name handler) (handler {:type event-name :target target})))');
+
+  // --- Test helper: count suspensions ---
+  function countSuspensions(result) {
+    return new Promise(resolve => {
+      let count = 0;
+      function drive(r) {
+        if (!r || !r.suspended) { resolve(count); return; }
+        count++;
+        const req = r.request;
+        const items = req && (req.items || req);
+        const op = items && items[0];
+        const opName = typeof op === 'string' ? op : (op && op.name) || String(op);
+        if (opName === 'io-sleep' || opName === 'wait') {
+          setTimeout(() => {
+            try { drive(r.resume(null)); }
+            catch(e) { console.error('  resume error:', e.message); resolve(count); }
+          }, 1);
+        } else { resolve(count); }
+      }
+      drive(result);
+    });
+  }
+
+  let pass = 0, fail = 0;
+  function assert(name, got, expected) {
+    if (got === expected) { pass++; console.log(`  ✓ ${name}`); }
+    else { fail++; console.error(`  ✗ ${name}: got ${got}, expected ${expected}`); }
+  }
+
+  // =====================================================================
+  // Test 1: SOURCE — load hs-repeat-times from .sx, call with perform
+  // =====================================================================
+  console.log('\n=== Test: SOURCE-loaded hs-repeat-times ===');
+
+  // Load from source
+  const hsFiles = ['tokenizer', 'parser', 'compiler', 'runtime'];
+  for (const f of hsFiles) {
+    K.load(fs.readFileSync(path.join(PROJECT_ROOT, 'lib/hyperscript', f + '.sx'), 'utf8'));
+  }
+
+  // Build handler and call it
+  K.eval(`(define _src-handler
+    (eval-expr
+      (list 'fn '(me)
+        (list 'let '((it nil) (event {:type "click"}))
+          (hs-to-sx-from-source "on click repeat 3 times add .active to me then wait 1ms then remove .active then wait 1ms end")))))`);
+
+  const srcMe = makeElement('button');
+  K.eval('(define _src-me (host-global "_srcMe"))');
+  global._srcMe = srcMe;
+  K.eval('(define _src-me (host-global "_srcMe"))');
+
+  let srcResult;
+  try { srcResult = K.callFn(K.eval('_src-handler'), [srcMe]); }
+  catch(e) { console.error('Source call error:', e.message); }
+
+  const srcSuspensions = await countSuspensions(srcResult);
+  assert('source: 6 suspensions (3 iters × 2 waits)', srcSuspensions, 6);
+
+  // =====================================================================
+  // Test 2: BYTECODE — load hs-repeat-times from .sxbc, call with perform
+  // =====================================================================
+  console.log('\n=== Test: BYTECODE-loaded hs-repeat-times ===');
+
+  // Reload from bytecode — overwrite the source-defined versions
+  if (K.beginModuleLoad) K.beginModuleLoad();
+  for (const f of ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime']) {
+    const bcPath = path.join(SX_DIR, f + '.sxbc');
+    if (fs.existsSync(bcPath)) {
+      const bcSrc = fs.readFileSync(bcPath, 'utf8');
+      K.load('(load-sxbc (first (parse "' + bcSrc.replace(/\\/g, '\\\\').replace(/"/g, '\\"') + '")))');
+    }
+  }
+  if (K.endModuleLoad) K.endModuleLoad();
+
+  // Build handler with the bytecode-loaded hs-repeat-times
+  K.eval(`(define _bc-handler
+    (eval-expr
+      (list 'fn '(me)
+        (list 'let '((it nil) (event {:type "click"}))
+          (hs-to-sx-from-source "on click repeat 3 times add .active to me then wait 1ms then remove .active then wait 1ms end")))))`);
+
+  const bcMe = makeElement('button');
+  global._bcMe = bcMe;
+  K.eval('(define _bc-me (host-global "_bcMe"))');
+
+  let bcResult;
+  try { bcResult = K.callFn(K.eval('_bc-handler'), [bcMe]); }
+  catch(e) { console.error('Bytecode call error:', e.message); }
+
+  const bcSuspensions = await countSuspensions(bcResult);
+  assert('bytecode: 6 suspensions (3 iters × 2 waits)', bcSuspensions, 6);
+
+  // =====================================================================
+  // Test 3: Minimal — just hs-repeat-times + perform, no hyperscript
+  // =====================================================================
+  console.log('\n=== Test: Minimal repeat + perform ===');
+
+  // Source version
+  K.eval('(define _src-count 0)');
+  K.eval(`(define _src-repeat-fn
+    (fn (n thunk)
+      (define do-repeat
+        (fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
+      (do-repeat 0)))`);
+  K.eval(`(define _src-repeat-thunk
+    (eval-expr '(fn () (_src-repeat-fn 3 (fn () (set! _src-count (+ _src-count 1)) (perform (list 'io-sleep 1)))))))`);
+
+  let minSrcResult;
+  try { minSrcResult = K.callFn(K.eval('_src-repeat-thunk'), []); }
+  catch(e) { console.error('Minimal source error:', e.message); }
+  const minSrcSusp = await countSuspensions(minSrcResult);
+  const minSrcCount = K.eval('_src-count');
+  assert('minimal source: 3 suspensions', minSrcSusp, 3);
+  assert('minimal source: count=3', minSrcCount, 3);
+
+  // =====================================================================
+  // Summary
+  // =====================================================================
+  console.log(`\n${pass} passed, ${fail} failed`);
+  process.exit(fail > 0 ? 1 : 0);
+}
+
+main().catch(e => { console.error('FATAL:', e.message); process.exit(1); });

hosts/ocaml/browser/test_driveAsync_order.js

@@ -0,0 +1,294 @@
+#!/usr/bin/env node
+// test_driveAsync_order.js — Verify DOM mutation order with real _driveAsync
+//
+// This test mimics the exact browser flow:
+// 1. host-callback wraps handler with K.callFn + _driveAsync
+// 2. dom-listen uses host-callback + host-call addEventListener
+// 3. Event fires → wrapper runs → _driveAsync drives suspension chain
+//
+// If there's a dual-path issue (_driveAsync + CEK chain both driving),
+// mutations will appear out of order.
+//
+// Expected: +active, -active, +active, -active, +active, -active (3 iterations)
+// Bug:      +active, +active, -active, ... (overlapping iterations)
+
+const fs = require('fs');
+const path = require('path');
+
+const PROJECT_ROOT = path.resolve(__dirname, '../../..');
+const WASM_DIR = path.join(PROJECT_ROOT, 'shared/static/wasm');
+
+// --- Track ALL mutations in order ---
+const mutations = [];
+
+function makeElement(tag) {
+  const el = {
+    tagName: tag, _attrs: {}, _children: [], _classes: new Set(),
+    _listeners: {},
+    style: {}, childNodes: [], children: [], textContent: '',
+    nodeType: 1,
+    classList: {
+      add(c) {
+        el._classes.add(c);
+        mutations.push('+' + c);
+        console.log('  [DOM] classList.add("' + c + '") → {' + [...el._classes] + '}');
+      },
+      remove(c) {
+        el._classes.delete(c);
+        mutations.push('-' + c);
+        console.log('  [DOM] classList.remove("' + c + '") → {' + [...el._classes] + '}');
+      },
+      contains(c) { return el._classes.has(c); },
+      toggle(c) { if (el._classes.has(c)) el._classes.delete(c); else el._classes.add(c); },
+    },
+    setAttribute(k, v) { el._attrs[k] = String(v); },
+    getAttribute(k) { return el._attrs[k] || null; },
+    removeAttribute(k) { delete el._attrs[k]; },
+    appendChild(c) { el._children.push(c); el.childNodes.push(c); el.children.push(c); return c; },
+    insertBefore(c) { el._children.push(c); el.childNodes.push(c); el.children.push(c); return c; },
+    removeChild(c) { return c; }, replaceChild(n) { return n; },
+    cloneNode() { return makeElement(tag); },
+    addEventListener(event, fn) {
+      if (!el._listeners[event]) el._listeners[event] = [];
+      el._listeners[event].push(fn);
+    },
+    removeEventListener(event, fn) {
+      if (el._listeners[event]) {
+        el._listeners[event] = el._listeners[event].filter(f => f !== fn);
+      }
+    },
+    dispatchEvent(e) {
+      const name = typeof e === 'string' ? e : e.type;
+      (el._listeners[name] || []).forEach(fn => fn(e));
+    },
+    get innerHTML() { return ''; }, set innerHTML(v) {},
+    get outerHTML() { return '<' + tag + '>'; },
+    dataset: {}, querySelectorAll() { return []; }, querySelector() { return null; },
+  };
+  return el;
+}
+
+global.window = global;
+global.document = {
+  createElement: makeElement,
+  createDocumentFragment() { return makeElement('fragment'); },
+  head: makeElement('head'), body: makeElement('body'),
+  querySelector() { return null; }, querySelectorAll() { return []; },
+  createTextNode(s) { return { _isText: true, textContent: String(s), nodeType: 3 }; },
+  addEventListener() {},
+  createComment(s) { return { _isComment: true, textContent: s || '', nodeType: 8 }; },
+  getElementsByTagName() { return []; },
+};
+global.localStorage = { getItem() { return null; }, setItem() {}, removeItem() {} };
+global.CustomEvent = class { constructor(n, o) { this.type = n; this.detail = (o || {}).detail || {}; } };
+global.MutationObserver = class { observe() {} disconnect() {} };
+global.requestIdleCallback = fn => setTimeout(fn, 0);
+global.matchMedia = () => ({ matches: false });
+global.navigator = { serviceWorker: { register() { return Promise.resolve(); } } };
+global.location = { href: '', pathname: '/', hostname: 'localhost' };
+global.history = { pushState() {}, replaceState() {} };
+global.fetch = () => Promise.resolve({ ok: true, text() { return Promise.resolve(''); } });
+global.XMLHttpRequest = class { open() {} send() {} };
+
+async function main() {
+  // Load WASM kernel
+  require(path.join(WASM_DIR, 'sx_browser.bc.js'));
+  const K = globalThis.SxKernel;
+  if (!K) { console.error('FATAL: SxKernel not found'); process.exit(1); }
+  console.log('WASM kernel loaded');
+
+  // --- Register FFI with the REAL _driveAsync (same as sx-platform.js) ---
+  K.registerNative('host-global', function(args) {
+    var name = args[0];
+    if (name in globalThis) return globalThis[name];
+    return null;
+  });
+  K.registerNative('host-get', function(args) {
+    var obj = args[0], prop = args[1];
+    if (obj == null) return null;
+    var v = obj[prop];
+    return v === undefined ? null : v;
+  });
+  K.registerNative('host-set!', function(args) {
+    if (args[0] != null) args[0][args[1]] = args[2];
+  });
+  K.registerNative('host-call', function(args) {
+    var obj = args[0], method = args[1];
+    var callArgs = [];
+    for (var i = 2; i < args.length; i++) callArgs.push(args[i]);
+    if (obj == null) return null;
+    if (typeof obj[method] === 'function') {
+      try { return obj[method].apply(obj, callArgs); }
+      catch(e) { console.error('[sx] host-call error:', e); return null; }
+    }
+    return null;
+  });
+  K.registerNative('host-new', function(args) {
+    return null;
+  });
+  K.registerNative('host-typeof', function(args) { return typeof args[0]; });
+  K.registerNative('host-await', function(args) { return args[0]; });
+
+  // THE REAL host-callback (same as sx-platform.js lines 82-97)
+  K.registerNative('host-callback', function(args) {
+    var fn = args[0];
+    if (typeof fn === 'function' && fn.__sx_handle === undefined) return fn;
+    if (fn && fn.__sx_handle !== undefined) {
+      return function() {
+        var a = Array.prototype.slice.call(arguments);
+        var result = K.callFn(fn, a);
+        // This is the line under investigation:
+        _driveAsync(result);
+        return result;
+      };
+    }
+    return function() {};
+  });
+
+  // THE REAL _driveAsync (same as sx-platform.js lines 104-138)
+  var _asyncPending = 0;
+  function _driveAsync(result) {
+    if (!result || !result.suspended) return;
+    _asyncPending++;
+    console.log('[driveAsync] suspension detected, pending=' + _asyncPending);
+    var req = result.request;
+    if (!req) { _asyncPending--; return; }
+    var items = req.items || req;
+    var op = (items && items[0]) || req;
+    var opName = (typeof op === 'string') ? op : (op && op.name) || String(op);
+
+    if (opName === 'wait' || opName === 'io-sleep') {
+      var ms = (items && items[1]) || 0;
+      if (typeof ms !== 'number') ms = parseFloat(ms) || 0;
+      // Use 1ms for test speed
+      setTimeout(function() {
+        try {
+          var resumed = result.resume(null);
+          _asyncPending--;
+          console.log('[driveAsync] resumed, pending=' + _asyncPending +
+            ', suspended=' + (resumed && resumed.suspended));
+          _driveAsync(resumed);
+        } catch(e) {
+          _asyncPending--;
+          console.error('[driveAsync] resume error:', e);
+        }
+      }, 1);
+    } else {
+      _asyncPending--;
+      console.warn('[driveAsync] unhandled IO:', opName);
+    }
+  }
+
+  K.eval('(define SX_VERSION "test-drive-async")');
+  K.eval('(define SX_ENGINE "ocaml-vm-wasm-test")');
+  K.eval('(define parse sx-parse)');
+  K.eval('(define serialize sx-serialize)');
+
+  // Load the REAL dom-listen (uses host-callback + host-call addEventListener)
+  K.eval(`(define dom-listen
+    (fn (el event-name handler)
+      (let ((cb (host-callback handler)))
+        (host-call el "addEventListener" event-name cb)
+        (fn () (host-call el "removeEventListener" event-name cb)))))`);
+
+  K.eval('(define dom-add-class (fn (el cls) (host-call (host-get el "classList") "add" cls)))');
+  K.eval('(define dom-remove-class (fn (el cls) (host-call (host-get el "classList") "remove" cls)))');
+  K.eval('(define dom-has-class? (fn (el cls) (host-call (host-get el "classList") "contains" cls)))');
+
+  // Load hyperscript modules — try bytecode first, fall back to source
+  const SX_DIR = path.join(WASM_DIR, 'sx');
+  const useBytecode = process.argv.includes('--bytecode');
+  if (useBytecode) {
+    console.log('Loading BYTECODE modules...');
+    const bcNames = ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime'];
+    for (const f of bcNames) {
+      const bcPath = path.join(SX_DIR, f + '.sxbc');
+      if (fs.existsSync(bcPath)) {
+        const bcSrc = fs.readFileSync(bcPath, 'utf8');
+        K.load('(load-sxbc (first (parse "' + bcSrc.replace(/\\/g, '\\\\').replace(/"/g, '\\"') + '")))');
+        console.log('  loaded ' + f + '.sxbc');
+      } else {
+        console.error('  MISSING ' + bcPath);
+      }
+    }
+  } else {
+    console.log('Loading SOURCE modules...');
+    const hsFiles = ['tokenizer', 'parser', 'compiler', 'runtime'];
+    for (const f of hsFiles) {
+      K.load(fs.readFileSync(path.join(PROJECT_ROOT, 'lib/hyperscript', f + '.sx'), 'utf8'));
+    }
+  }
+  console.log('Hyperscript modules loaded');
+
+  // Create element
+  const btn = makeElement('button');
+  global._testBtn = btn;
+  K.eval('(define _btn (host-global "_testBtn"))');
+
+  // Compile + register handler using hs-on (which uses dom-listen → host-callback → addEventListener)
+  console.log('\n=== Setting up hs-on handler ===');
+  K.eval(`(hs-on _btn "click"
+    (fn (event)
+      (hs-repeat-times 3
+        (fn ()
+          (do
+            (dom-add-class _btn "active")
+            (hs-wait 300)
+            (dom-remove-class _btn "active")
+            (hs-wait 300))))))`);
+
+  console.log('Handler registered, listeners:', Object.keys(btn._listeners));
+  console.log('Click listeners count:', (btn._listeners.click || []).length);
+
+  // Simulate click — fires the event listener which goes through host-callback + _driveAsync
+  console.log('\n=== Simulating click ===');
+  mutations.length = 0;
+  btn.dispatchEvent({ type: 'click', target: btn });
+
+  // Wait for all async resumes to complete
+  await new Promise(resolve => {
+    function check() {
+      if (_asyncPending === 0 && mutations.length > 0) {
+        // Give a tiny extra delay to make sure nothing else fires
+        setTimeout(() => {
+          if (_asyncPending === 0) resolve();
+          else check();
+        }, 10);
+      } else {
+        setTimeout(check, 5);
+      }
+    }
+    setTimeout(check, 50);
+  });
+
+  // Verify mutation order
+  console.log('\n=== Results ===');
+  console.log('Mutations:', mutations.join(', '));
+  console.log('Count:', mutations.length, '(expected: 6)');
+
+  const expected = ['+active', '-active', '+active', '-active', '+active', '-active'];
+  let pass = true;
+  if (mutations.length !== expected.length) {
+    console.error(`FAIL: expected ${expected.length} mutations, got ${mutations.length}`);
+    pass = false;
+  } else {
+    for (let i = 0; i < expected.length; i++) {
+      if (mutations[i] !== expected[i]) {
+        console.error(`FAIL at index ${i}: expected ${expected[i]}, got ${mutations[i]}`);
+        pass = false;
+      }
+    }
+  }
+
+  if (pass) {
+    console.log('PASS: mutation order is correct');
+  } else {
+    console.log('FAIL: mutation order is wrong');
+    console.log('Expected:', expected.join(', '));
+    console.log('Got:     ', mutations.join(', '));
+  }
+
+  process.exit(pass ? 0 : 1);
+}
+
+main().catch(e => { console.error('FATAL:', e); process.exit(1); });

hosts/ocaml/browser/test_hs_repeat.js

@@ -0,0 +1,229 @@
+#!/usr/bin/env node
+// test_hs_repeat.js — Debug hyperscript repeat+wait continuation bug
+//
+// Runs the exact expression that fails in the browser:
+//   on click repeat 3 times add .active to me then wait 300ms
+//     then remove .active then wait 300ms end
+//
+// Uses the real WASM kernel with perform/resume_vm, NOT mock IO.
+// Waits are shortened to 1ms. All IO suspensions are logged.
+//
+// Usage: node hosts/ocaml/browser/test_hs_repeat.js
+
+const fs = require('fs');
+const path = require('path');
+
+const PROJECT_ROOT = path.resolve(__dirname, '../../..');
+const WASM_DIR = path.join(PROJECT_ROOT, 'shared/static/wasm');
+
+// --- DOM stubs with class tracking ---
+function makeElement(tag) {
+  const el = {
+    tagName: tag, _attrs: {}, _children: [], _classes: new Set(),
+    style: {}, childNodes: [], children: [], textContent: '',
+    nodeType: 1,
+    classList: {
+      add(c) { el._classes.add(c); console.log(`  [dom] classList.add("${c}") → {${[...el._classes]}}`); },
+      remove(c) { el._classes.delete(c); console.log(`  [dom] classList.remove("${c}") → {${[...el._classes]}}`); },
+      contains(c) { return el._classes.has(c); },
+      toggle(c) { if (el._classes.has(c)) el._classes.delete(c); else el._classes.add(c); },
+    },
+    setAttribute(k, v) { el._attrs[k] = String(v); },
+    getAttribute(k) { return el._attrs[k] || null; },
+    removeAttribute(k) { delete el._attrs[k]; },
+    appendChild(c) { el._children.push(c); el.childNodes.push(c); el.children.push(c); return c; },
+    insertBefore(c) { el._children.push(c); el.childNodes.push(c); el.children.push(c); return c; },
+    removeChild(c) { return c; },
+    replaceChild(n) { return n; },
+    cloneNode() { return makeElement(tag); },
+    addEventListener() {}, removeEventListener() {}, dispatchEvent() {},
+    get innerHTML() {
+      return el._children.map(c => {
+        if (c._isText) return c.textContent || '';
+        if (c._isComment) return '<!--' + (c.textContent || '') + '-->';
+        return c.outerHTML || '';
+      }).join('');
+    },
+    set innerHTML(v) { el._children = []; el.childNodes = []; el.children = []; },
+    get outerHTML() {
+      let s = '<' + tag;
+      for (const k of Object.keys(el._attrs).sort()) s += ` ${k}="${el._attrs[k]}"`;
+      s += '>';
+      if (['br','hr','img','input','meta','link'].includes(tag)) return s;
+      return s + el.innerHTML + '</' + tag + '>';
+    },
+    dataset: new Proxy({}, {
+      get(_, k) { return el._attrs['data-' + k.replace(/[A-Z]/g, c => '-' + c.toLowerCase())]; },
+      set(_, k, v) { el._attrs['data-' + k.replace(/[A-Z]/g, c => '-' + c.toLowerCase())] = v; return true; }
+    }),
+    querySelectorAll() { return []; },
+    querySelector() { return null; },
+  };
+  return el;
+}
+
+global.window = global;
+global.document = {
+  createElement: makeElement,
+  createDocumentFragment() { return makeElement('fragment'); },
+  head: makeElement('head'), body: makeElement('body'),
+  querySelector() { return null; }, querySelectorAll() { return []; },
+  createTextNode(s) { return { _isText: true, textContent: String(s), nodeType: 3 }; },
+  addEventListener() {},
+  createComment(s) { return { _isComment: true, textContent: s || '', nodeType: 8 }; },
+  getElementsByTagName() { return []; },
+};
+global.localStorage = { getItem() { return null; }, setItem() {}, removeItem() {} };
+global.CustomEvent = class { constructor(n, o) { this.type = n; this.detail = (o || {}).detail || {}; } };
+global.MutationObserver = class { observe() {} disconnect() {} };
+global.requestIdleCallback = fn => setTimeout(fn, 0);
+global.matchMedia = () => ({ matches: false });
+global.navigator = { serviceWorker: { register() { return Promise.resolve(); } } };
+global.location = { href: '', pathname: '/', hostname: 'localhost' };
+global.history = { pushState() {}, replaceState() {} };
+global.fetch = () => Promise.resolve({ ok: true, text() { return Promise.resolve(''); } });
+global.XMLHttpRequest = class { open() {} send() {} };
+
+async function main() {
+  // Load WASM kernel
+  require(path.join(WASM_DIR, 'sx_browser.bc.js'));
+  const K = globalThis.SxKernel;
+  if (!K) { console.error('FATAL: SxKernel not found'); process.exit(1); }
+  console.log('WASM kernel loaded');
+
+  // Register FFI primitives
+  K.registerNative('host-global', args => {
+    const name = args[0];
+    return (name in globalThis) ? globalThis[name] : null;
+  });
+  K.registerNative('host-get', args => {
+    const [obj, prop] = args;
+    if (obj == null) return null;
+    const v = obj[prop];
+    return v === undefined ? null : v;
+  });
+  K.registerNative('host-set!', args => { if (args[0] != null) args[0][args[1]] = args[2]; return args[2]; });
+  K.registerNative('host-call', args => {
+    const [obj, method, ...rest] = args;
+    if (obj == null || typeof obj[method] !== 'function') return null;
+    const r = obj[method].apply(obj, rest);
+    return r === undefined ? null : r;
+  });
+  K.registerNative('host-new', args => new (Function.prototype.bind.apply(args[0], [null, ...args.slice(1)])));
+  K.registerNative('host-callback', args => {
+    const fn = args[0];
+    return function() { return K.callFn(fn, Array.from(arguments)); };
+  });
+  K.registerNative('host-typeof', args => typeof args[0]);
+  K.registerNative('host-await', args => args[0]);
+
+  K.eval('(define SX_VERSION "test-hs-1.0")');
+  K.eval('(define SX_ENGINE "ocaml-vm-wasm-test")');
+  K.eval('(define parse sx-parse)');
+  K.eval('(define serialize sx-serialize)');
+
+  // Stub DOM primitives that HS runtime calls
+  // dom-listen fires handler immediately (simulates the event)
+  K.eval('(define dom-add-class (fn (el cls) (dict-set! (get el "classes") cls true) nil))');
+  K.eval('(define dom-remove-class (fn (el cls) (dict-delete! (get el "classes") cls) nil))');
+  K.eval('(define dom-has-class? (fn (el cls) (dict-has? (get el "classes") cls)))');
+  K.eval('(define dom-listen (fn (target event-name handler) (handler {:type event-name :target target})))');
+
+  // Load hyperscript modules
+  const hsFiles = [
+    'lib/hyperscript/tokenizer.sx',
+    'lib/hyperscript/parser.sx',
+    'lib/hyperscript/compiler.sx',
+    'lib/hyperscript/runtime.sx',
+  ];
+  for (const f of hsFiles) {
+    const src = fs.readFileSync(path.join(PROJECT_ROOT, f), 'utf8');
+    const r = K.load(src);
+    if (typeof r === 'string' && r.startsWith('Error')) {
+      console.error(`Load failed: ${f}: ${r}`);
+      process.exit(1);
+    }
+  }
+  console.log('Hyperscript modules loaded');
+
+  // Compile the expression
+  const compiled = K.eval('(hs-to-sx-from-source "on click repeat 3 times add .active to me then wait 300ms then remove .active then wait 300ms end")');
+  console.log('Compiled:', K.eval(`(inspect '${typeof compiled === 'string' ? compiled : '?'})`));
+  // Actually get it as a string
+  const compiledStr = K.eval('(inspect (hs-to-sx-from-source "on click repeat 3 times add .active to me then wait 300ms then remove .active then wait 300ms end"))');
+  console.log('Compiled SX:', compiledStr);
+
+  // Create handler function (same as hs-handler does)
+  K.eval('(define _test-me {:tag "button" :id "test" :classes {} :_hs-activated true})');
+
+  // Build the handler — wraps compiled SX in (fn (me) (let ((it nil) (event ...)) <sx>))
+  const handlerSrc = K.eval('(inspect (hs-to-sx-from-source "on click repeat 3 times add .active to me then wait 300ms then remove .active then wait 300ms end"))');
+  K.eval(`(define _test-handler
+    (eval-expr
+      (list 'fn '(me)
+        (list 'let '((it nil) (event {:type "click" :target _test-me}))
+          (hs-to-sx-from-source "on click repeat 3 times add .active to me then wait 300ms then remove .active then wait 300ms end")))))`);
+
+  console.log('\n=== Invoking handler (simulates click event) ===');
+  console.log('Expected: 3 iterations × (add .active, wait 300, remove .active, wait 300)');
+  console.log('Expected: 6 IO suspensions total\n');
+
+  // Call the handler — this will suspend on the first hs-wait (perform)
+  let suspensionCount = 0;
+  let result;
+  try {
+    result = K.callFn(K.eval('_test-handler'), [K.eval('_test-me')]);
+  } catch(e) {
+    console.error('Initial call error:', e.message);
+    process.exit(1);
+  }
+
+  // Drive async suspension chain with real timeouts (1ms instead of 300ms)
+  function driveAsync(res) {
+    return new Promise((resolve) => {
+      function step(r) {
+        if (!r || !r.suspended) {
+          console.log(`\n=== Done. Total suspensions: ${suspensionCount} (expected: 6) ===`);
+          console.log(`Result: ${r === null ? 'null' : typeof r === 'object' ? JSON.stringify(r) : r}`);
+          resolve();
+          return;
+        }
+
+        suspensionCount++;
+        const req = r.request;
+        const items = req && (req.items || req);
+        const op = items && items[0];
+        const opName = typeof op === 'string' ? op : (op && op.name) || String(op);
+        const arg = items && items[1];
+
+        console.log(`Suspension #${suspensionCount}: op=${opName} arg=${arg}`);
+
+        if (opName === 'io-sleep' || opName === 'wait') {
+          // Resume after 1ms (not real 300ms)
+          setTimeout(() => {
+            try {
+              const resumed = r.resume(null);
+              console.log(`  Resumed: suspended=${resumed && resumed.suspended}, type=${typeof resumed}`);
+              step(resumed);
+            } catch(e) {
+              console.error(`  Resume error: ${e.message}`);
+              resolve();
+            }
+          }, 1);
+        } else {
+          console.log(`  Unhandled IO op: ${opName}`);
+          resolve();
+        }
+      }
+      step(res);
+    });
+  }
+
+  await driveAsync(result);
+
+  // Check final element state
+  const classes = K.eval('(get _test-me "classes")');
+  console.log('\nFinal element classes:', JSON.stringify(classes));
+}
+
+main().catch(e => { console.error('FATAL:', e.message); process.exit(1); });

hosts/ocaml/browser/test_wasm.sh

@@ -299,6 +299,48 @@ node -e '
     K.eval("(let ((d (list))) (let ((el (with-island-scope (fn (x) (append! d x)) (fn () (render-to-dom (quote (div :class (deref test-reactive-sig) \"content\")) (global-env) nil))))) (reset! test-reactive-sig \"after\") (dom-get-attr el \"class\")))"),
     "after");
 
+  // =====================================================================
+  // Section 4: Letrec + perform resume (async _driveAsync)
+  // =====================================================================
+
+  // Define the letrec+perform pattern — this matches the test-runner island
+  K.eval("(define __letrec-test-fn (letrec ((other (fn () \"from-other\")) (go (fn () (do (perform {:op \"io-sleep\" :args (list 50)}) (other))))) go))");
+
+  // Get the function as a JS-callable value
+  var letrecFn = K.eval("__letrec-test-fn");
+  if (typeof letrecFn !== "function") {
+    fail++; console.error("FAIL: letrec-fn not callable, got: " + typeof letrecFn);
+  } else {
+    // Call via callFn — same path as island click handlers
+    var letrecResult = K.callFn(letrecFn, []);
+    // Resume through all suspensions — tests that resume() preserves letrec env
+    try {
+      while (letrecResult && letrecResult.suspended) { letrecResult = letrecResult.resume(null); }
+      assert("letrec sibling after perform resume", letrecResult, "from-other");
+    } catch(e) {
+      fail++; console.error("FAIL: letrec perform resume: " + (e.message || e));
+    }
+  }
+
+  // Recursive letrec after perform — the wait-boot pattern
+  K.eval("(define __wb-counter 0)");
+  K.eval("(define __recur-test-fn (letrec ((recur (fn () (set! __wb-counter (+ __wb-counter 1)) (if (>= __wb-counter 3) \"done\" (do (perform {:op \"io-sleep\" :args (list 10)}) (recur)))))) (fn () (set! __wb-counter 0) (recur))))");
+
+  var recurFn = K.eval("__recur-test-fn");
+  if (typeof recurFn !== "function") {
+    fail++; console.error("FAIL: recur-fn not callable, got: " + typeof recurFn);
+  } else {
+    var recurResult = K.callFn(recurFn, []);
+    try {
+      // Resume through all suspensions synchronously
+      while (recurResult && recurResult.suspended) { recurResult = recurResult.resume(null); }
+      assert("recursive letrec after perform", recurResult, "done");
+      assert("recursive letrec counter", K.eval("__wb-counter"), 3);
+    } catch(e) {
+      fail++; console.error("FAIL: recursive letrec perform: " + (e.message || e));
+    }
+  }
+
   // =====================================================================
   // Summary
   // =====================================================================

hosts/ocaml/lib/sx_cst.ml

@@ -104,6 +104,33 @@ let rec cst_to_ast = function
     Dict d
 
 
+(** Convert character offset to line/col (1-based lines, 0-based cols) *)
+let offset_to_loc src offset =
+  let line = ref 1 and col = ref 0 in
+  for i = 0 to min (offset - 1) (String.length src - 1) do
+    if src.[i] = '\n' then (incr line; col := 0)
+    else col := !col + 1
+  done;
+  (!line, !col)
+
+(** CST → AST with source location dicts ({:form value :line N :col N}) *)
+let cst_to_ast_loc src nodes =
+  List.map (fun node ->
+    let span = match node with
+      | CstAtom { span; _ } -> span
+      | CstList { span; _ } -> span
+      | CstDict { span; _ } -> span
+    in
+    let value = cst_to_ast node in
+    let (line, col) = offset_to_loc src span.start_offset in
+    let d = make_dict () in
+    dict_set d "form" value;
+    dict_set d "line" (Number (float_of_int line));
+    dict_set d "col" (Number (float_of_int col));
+    Dict d
+  ) nodes
+
+
 (** {1 CST editing — apply AST-level edits back to the CST} *)
 
 (** Replace the CST node at [path] with [new_source], preserving the

hosts/ocaml/lib/sx_parser.ml

@@ -65,6 +65,7 @@ let read_string s =
        | 'r' -> Buffer.add_char buf '\r'
        | '"' -> Buffer.add_char buf '"'
        | '\\' -> Buffer.add_char buf '\\'
+       | '/' -> Buffer.add_char buf '/'
        | 'u' ->
          (* \uXXXX — read 4 hex digits, encode as UTF-8 *)
          if s.pos + 4 > s.len then raise (Parse_error "Incomplete \\u escape");

hosts/ocaml/lib/sx_primitives.ml

@@ -79,9 +79,7 @@ let as_bool = function
 
 let rec to_string = function
   | String s -> s
-  | Number n ->
-    if Float.is_integer n then string_of_int (int_of_float n)
-    else Printf.sprintf "%g" n
+  | Number n -> Sx_types.format_number n
   | Bool true -> "true"
   | Bool false -> "false"
   | Nil -> ""
@@ -144,6 +142,90 @@ let () =
   register "pow" (fun args ->
     match args with [a; b] -> Number (as_number a ** as_number b)
     | _ -> raise (Eval_error "pow: 2 args"));
+  register "cbrt" (fun args ->
+    match args with [a] -> Number (Float.cbrt (as_number a)) | _ -> raise (Eval_error "cbrt: 1 arg"));
+  register "exp" (fun args ->
+    match args with [a] -> Number (Float.exp (as_number a)) | _ -> raise (Eval_error "exp: 1 arg"));
+  register "expm1" (fun args ->
+    match args with [a] -> Number (Float.expm1 (as_number a)) | _ -> raise (Eval_error "expm1: 1 arg"));
+  register "log" (fun args ->
+    match args with [a] -> Number (Float.log (as_number a)) | _ -> raise (Eval_error "log: 1 arg"));
+  register "log2" (fun args ->
+    match args with [a] -> Number (Float.log (as_number a) /. Float.log 2.0) | _ -> raise (Eval_error "log2: 1 arg"));
+  register "log10" (fun args ->
+    match args with [a] -> Number (Float.log10 (as_number a)) | _ -> raise (Eval_error "log10: 1 arg"));
+  register "log1p" (fun args ->
+    match args with [a] -> Number (Float.log1p (as_number a)) | _ -> raise (Eval_error "log1p: 1 arg"));
+  register "sin" (fun args ->
+    match args with [a] -> Number (Float.sin (as_number a)) | _ -> raise (Eval_error "sin: 1 arg"));
+  register "cos" (fun args ->
+    match args with [a] -> Number (Float.cos (as_number a)) | _ -> raise (Eval_error "cos: 1 arg"));
+  register "tan" (fun args ->
+    match args with [a] -> Number (Float.tan (as_number a)) | _ -> raise (Eval_error "tan: 1 arg"));
+  register "asin" (fun args ->
+    match args with [a] -> Number (Float.asin (as_number a)) | _ -> raise (Eval_error "asin: 1 arg"));
+  register "acos" (fun args ->
+    match args with [a] -> Number (Float.acos (as_number a)) | _ -> raise (Eval_error "acos: 1 arg"));
+  register "atan" (fun args ->
+    match args with [a] -> Number (Float.atan (as_number a)) | _ -> raise (Eval_error "atan: 1 arg"));
+  register "atan2" (fun args ->
+    match args with [a; b] -> Number (Float.atan2 (as_number a) (as_number b))
+    | _ -> raise (Eval_error "atan2: 2 args"));
+  register "sinh" (fun args ->
+    match args with [a] -> Number (Float.sinh (as_number a)) | _ -> raise (Eval_error "sinh: 1 arg"));
+  register "cosh" (fun args ->
+    match args with [a] -> Number (Float.cosh (as_number a)) | _ -> raise (Eval_error "cosh: 1 arg"));
+  register "tanh" (fun args ->
+    match args with [a] -> Number (Float.tanh (as_number a)) | _ -> raise (Eval_error "tanh: 1 arg"));
+  register "asinh" (fun args ->
+    match args with [a] -> Number (Float.asinh (as_number a)) | _ -> raise (Eval_error "asinh: 1 arg"));
+  register "acosh" (fun args ->
+    match args with [a] -> Number (Float.acosh (as_number a)) | _ -> raise (Eval_error "acosh: 1 arg"));
+  register "atanh" (fun args ->
+    match args with [a] -> Number (Float.atanh (as_number a)) | _ -> raise (Eval_error "atanh: 1 arg"));
+  register "hypot" (fun args ->
+    let square x = x *. x in
+    let sum = List.fold_left (fun acc a -> acc +. square (as_number a)) 0.0 args in
+    Number (Float.sqrt sum));
+  register "sign" (fun args ->
+    match args with
+    | [a] ->
+      let n = as_number a in
+      Number (if Float.is_nan n then Float.nan
+              else if n > 0.0 then 1.0
+              else if n < 0.0 then -1.0
+              else n)
+    | _ -> raise (Eval_error "sign: 1 arg"));
+  register "fround" (fun args ->
+    match args with [a] -> Number (Int32.float_of_bits (Int32.bits_of_float (as_number a)))
+    | _ -> raise (Eval_error "fround: 1 arg"));
+  register "clz32" (fun args ->
+    match args with
+    | [a] ->
+      let n = as_number a in
+      let i = if Float.is_nan n || Float.is_infinite n then 0l
+              else Int32.of_float (Float.rem n 4294967296.0) in
+      if i = 0l then Number 32.0
+      else
+        let high_bit = Int32.shift_left 1l 31 in
+        let count = ref 0 in
+        let x = ref i in
+        while Int32.logand !x high_bit = 0l do
+          incr count;
+          x := Int32.shift_left !x 1
+        done;
+        Number (float_of_int !count)
+    | _ -> raise (Eval_error "clz32: 1 arg"));
+  register "imul" (fun args ->
+    match args with
+    | [a; b] ->
+      let tou32 f =
+        if Float.is_nan f || Float.is_infinite f then 0l
+        else Int32.of_float (Float.rem f 4294967296.0) in
+      let ai = tou32 (as_number a) and bi = tou32 (as_number b) in
+      let r = Int32.mul ai bi in
+      Number (Int32.to_float r)
+    | _ -> raise (Eval_error "imul: 2 args"));
   register "clamp" (fun args ->
     match args with
     | [x; lo; hi] ->
@@ -346,13 +428,13 @@ let () =
     | [String s; String prefix] ->
       Bool (String.length s >= String.length prefix &&
             String.sub s 0 (String.length prefix) = prefix)
-    | _ -> raise (Eval_error "starts-with?: 2 string args"));
+    | _ -> Bool false);
   register "ends-with?" (fun args ->
     match args with
     | [String s; String suffix] ->
       let sl = String.length s and xl = String.length suffix in
       Bool (sl >= xl && String.sub s (sl - xl) xl = suffix)
-    | _ -> raise (Eval_error "ends-with?: 2 string args"));
+    | _ -> Bool false);
   register "index-of" (fun args ->
     match args with
     | [String haystack; String needle] ->
@@ -941,7 +1023,19 @@ let () =
     | [f; Nil] -> call f []
     | _ -> raise (Eval_error "apply: function and list"));
   register "identical?" (fun args ->
-    match args with [a; b] -> Bool (a == b) | _ -> raise (Eval_error "identical?: 2 args"));
+    match args with
+    | [a; b] ->
+      (* Physical identity for reference types, structural for values.
+         Numbers/strings/booleans from different constant pools must
+         compare equal when their values match. *)
+      let identical = match a, b with
+        | Number x, Number y -> x = y
+        | String x, String y -> x = y  (* String.equal *)
+        | Bool x, Bool y -> x = y
+        | Nil, Nil -> true
+        | _ -> a == b  (* reference identity for dicts, lists, etc. *)
+      in Bool identical
+    | _ -> raise (Eval_error "identical?: 2 args"));
   register "make-spread" (fun args ->
     match args with
     | [Dict d] ->
@@ -1591,4 +1685,190 @@ let () =
 
   register "provide-pop!" (fun args ->
     match Hashtbl.find_opt primitives "scope-pop!" with
-    | Some fn -> fn args | None -> Nil)
+    | Some fn -> fn args | None -> Nil);
+
+  (* hs-safe-call: invoke a 0-arg thunk, return nil on any native error.
+     Used by the hyperscript compiler to wrap collection expressions in
+     for-loops, so `for x in doesNotExist` iterates over nil instead of
+     crashing with an undefined-symbol error. *)
+  register "hs-safe-call" (fun args ->
+    match args with
+    | [thunk] ->
+      (try !Sx_types._cek_call_ref thunk Nil
+       with _ -> Nil)
+    | _ -> Nil);
+
+  (* === Regex === wrapping Re + Re.Pcre *)
+  let regex_table : (int, Re.re * string * string) Hashtbl.t = Hashtbl.create 32 in
+  let regex_next_id = ref 0 in
+  let parse_flags flags =
+    let opts = ref [] in
+    String.iter (function
+      | 'i' -> opts := `CASELESS :: !opts
+      | 'm' -> opts := `MULTILINE :: !opts
+      | 's' -> opts := `DOTALL :: !opts
+      | _ -> ()) flags;
+    !opts
+  in
+  let make_regex_value id source flags =
+    let d = Hashtbl.create 4 in
+    Hashtbl.replace d "__regex__" (Bool true);
+    Hashtbl.replace d "id" (Number (float_of_int id));
+    Hashtbl.replace d "source" (String source);
+    Hashtbl.replace d "flags" (String flags);
+    Dict d
+  in
+  let regex_of_value = function
+    | Dict d ->
+      (match Hashtbl.find_opt d "id" with
+       | Some (Number n) ->
+         (match Hashtbl.find_opt regex_table (int_of_float n) with
+          | Some r -> r
+          | None -> raise (Eval_error "regex: handle not found"))
+       | _ -> raise (Eval_error "regex: missing id"))
+    | _ -> raise (Eval_error "regex: expected regex dict")
+  in
+  let group_to_dict g input =
+    let d = Hashtbl.create 4 in
+    Hashtbl.replace d "match" (String (Re.Group.get g 0));
+    Hashtbl.replace d "index" (Number (float_of_int (Re.Group.start g 0)));
+    Hashtbl.replace d "input" (String input);
+    let count = Re.Group.nb_groups g in
+    let groups = ref [] in
+    for i = count - 1 downto 1 do
+      let s = try Re.Group.get g i with Not_found -> "" in
+      groups := String s :: !groups
+    done;
+    Hashtbl.replace d "groups" (List !groups);
+    Dict d
+  in
+  register "regex-compile" (fun args ->
+    match args with
+    | [String source; String flags] | [String source; String flags; _] ->
+      let opts = parse_flags flags in
+      (try
+        let re = Re.compile (Re.Pcre.re ~flags:opts source) in
+        let id = !regex_next_id in
+        incr regex_next_id;
+        Hashtbl.replace regex_table id (re, source, flags);
+        make_regex_value id source flags
+      with _ -> raise (Eval_error ("regex-compile: invalid pattern " ^ source)))
+    | [String source] ->
+      (try
+        let re = Re.compile (Re.Pcre.re source) in
+        let id = !regex_next_id in
+        incr regex_next_id;
+        Hashtbl.replace regex_table id (re, source, "");
+        make_regex_value id source ""
+      with _ -> raise (Eval_error ("regex-compile: invalid pattern " ^ source)))
+    | _ -> raise (Eval_error "regex-compile: (source flags)"));
+  register "regex-test" (fun args ->
+    match args with
+    | [rx; String s] ->
+      let (re, _, _) = regex_of_value rx in
+      Bool (Re.execp re s)
+    | _ -> raise (Eval_error "regex-test: (regex string)"));
+  register "regex-exec" (fun args ->
+    let (rx, s, start) = match args with
+      | [rx; String s] -> (rx, s, 0)
+      | [rx; String s; Number n] -> (rx, s, int_of_float n)
+      | _ -> raise (Eval_error "regex-exec: (regex string start?)")
+    in
+    let (re, _, _) = regex_of_value rx in
+    try
+      let g = Re.exec ~pos:start re s in
+      group_to_dict g s
+    with Not_found -> Nil);
+  register "regex-match-all" (fun args ->
+    match args with
+    | [rx; String s] ->
+      let (re, _, _) = regex_of_value rx in
+      let all = Re.all re s in
+      List (List.map (fun g -> group_to_dict g s) all)
+    | _ -> raise (Eval_error "regex-match-all: (regex string)"));
+  register "regex-replace" (fun args ->
+    match args with
+    | [rx; String s; String replacement] ->
+      let (re, _, flags) = regex_of_value rx in
+      let expand g =
+        let buf = Buffer.create (String.length replacement) in
+        let i = ref 0 in
+        let n = String.length replacement in
+        while !i < n do
+          let c = replacement.[!i] in
+          if c = '$' && !i + 1 < n then
+            (match replacement.[!i + 1] with
+             | '&' -> Buffer.add_string buf (Re.Group.get g 0); i := !i + 2
+             | '$' -> Buffer.add_char buf '$'; i := !i + 2
+             | c when c >= '0' && c <= '9' ->
+               let idx = Char.code c - Char.code '0' in
+               (try Buffer.add_string buf (Re.Group.get g idx) with Not_found -> ());
+               i := !i + 2
+             | _ -> Buffer.add_char buf c; incr i)
+          else (Buffer.add_char buf c; incr i)
+        done;
+        Buffer.contents buf
+      in
+      let global = String.contains flags 'g' in
+      if global then
+        String (Re.replace re ~f:expand s)
+      else
+        (match Re.exec_opt re s with
+         | None -> String s
+         | Some g ->
+           let repl = expand g in
+           let before = String.sub s 0 (Re.Group.start g 0) in
+           let after_start = Re.Group.stop g 0 in
+           let after = String.sub s after_start (String.length s - after_start) in
+           String (before ^ repl ^ after))
+    | _ -> raise (Eval_error "regex-replace: (regex string replacement)"));
+  register "regex-replace-fn" (fun args ->
+    match args with
+    | [rx; String s; f] ->
+      let (re, _, flags) = regex_of_value rx in
+      let call_fn g =
+        let match_str = Re.Group.get g 0 in
+        let count = Re.Group.nb_groups g in
+        let groups_before = ref [] in
+        for i = count - 1 downto 1 do
+          let v = try String (Re.Group.get g i) with Not_found -> Nil in
+          groups_before := v :: !groups_before
+        done;
+        let idx = Number (float_of_int (Re.Group.start g 0)) in
+        let all_args = [String match_str] @ !groups_before @ [idx; String s] in
+        match !Sx_types._cek_call_ref f (List all_args) with
+        | String s -> s
+        | Number n -> Sx_types.format_number n
+        | v -> Sx_types.inspect v
+      in
+      let global = String.contains flags 'g' in
+      if global then
+        String (Re.replace re ~f:call_fn s)
+      else
+        (match Re.exec_opt re s with
+         | None -> String s
+         | Some g ->
+           let repl = call_fn g in
+           let before = String.sub s 0 (Re.Group.start g 0) in
+           let after_start = Re.Group.stop g 0 in
+           let after = String.sub s after_start (String.length s - after_start) in
+           String (before ^ repl ^ after))
+    | _ -> raise (Eval_error "regex-replace-fn: (regex string fn)"));
+  register "regex-split" (fun args ->
+    match args with
+    | [rx; String s] ->
+      let (re, _, _) = regex_of_value rx in
+      List (List.map (fun x -> String x) (Re.split re s))
+    | _ -> raise (Eval_error "regex-split: (regex string)"));
+  register "regex-source" (fun args ->
+    match args with
+    | [rx] ->
+      let (_, source, _) = regex_of_value rx in
+      String source
+    | _ -> raise (Eval_error "regex-source: (regex)"));
+  register "regex-flags" (fun args ->
+    match args with
+    | [rx] ->
+      let (_, _, flags) = regex_of_value rx in
+      String flags
+    | _ -> raise (Eval_error "regex-flags: (regex)"))

hosts/ocaml/lib/sx_render.ml

@@ -64,6 +64,7 @@ let expand_macro m args_val _env = match m with
 let try_catch try_fn catch_fn =
   try sx_call try_fn []
   with
+  | Sx_vm.VmSuspended _ as e -> raise e
   | Eval_error msg -> sx_call catch_fn [String msg]
   | e -> sx_call catch_fn [String (Printexc.to_string e)]
 

hosts/ocaml/lib/sx_runtime.ml

@@ -15,9 +15,7 @@ let prim_call name args =
 (** Convert any SX value to an OCaml string (internal). *)
 let value_to_str = function
   | String s -> s
-  | Number n ->
-    if Float.is_integer n then string_of_int (int_of_float n)
-    else Printf.sprintf "%g" n
+  | Number n -> Sx_types.format_number n
   | Bool true -> "true"
   | Bool false -> "false"
   | Nil -> ""
@@ -44,10 +42,8 @@ let sx_call f args =
   match f with
   | NativeFn (_, fn) -> fn args
   | VmClosure cl -> !Sx_types._vm_call_closure_ref cl args
-  | Lambda l ->
-    let local = Sx_types.env_extend l.l_closure in
-    List.iter2 (fun p a -> ignore (Sx_types.env_bind local p a)) l.l_params args;
-    Thunk (l.l_body, local)
+  | Lambda _ ->
+    !Sx_types._cek_eval_lambda_ref f args
   | Continuation (k, _) ->
     k (match args with x :: _ -> x | [] -> Nil)
   | CallccContinuation _ ->
@@ -75,11 +71,22 @@ let sx_apply_cek f args_list =
   match f with
   | NativeFn _ | VmClosure _ ->
     (try sx_apply f args_list
-     with Eval_error msg ->
+     with
+     | CekPerformRequest _ as e -> raise e
+     | exn ->
+       (* Check if this is a VM suspension — return marker dict so
+          continue_with_call can build a proper suspended CEK state
+          with vm-resume-frame on the kont. *)
+       (match !_vm_suspension_to_dict exn with
+        | Some marker -> marker
+        | None ->
+          (match exn with
+           | Eval_error msg ->
              let d = Hashtbl.create 3 in
              Hashtbl.replace d "__eval_error__" (Bool true);
              Hashtbl.replace d "message" (String msg);
-       Dict d)
+             Dict d
+           | _ -> raise exn)))
   | _ -> sx_apply f args_list
 
 (** Check if a value is an eval-error marker from sx_apply_cek. *)
@@ -186,6 +193,7 @@ let get_val container key =
        Hashtbl.replace d "vc-bytecode" (List bc);
        Hashtbl.replace d "vc-constants" (List consts);
        Hashtbl.replace d "vc-arity" (Number (float_of_int c.vc_arity));
+       Hashtbl.replace d "vc-rest-arity" (Number (float_of_int c.vc_rest_arity));
        Hashtbl.replace d "vc-locals" (Number (float_of_int c.vc_locals));
        Dict d
      | "vm-upvalues" ->
@@ -496,13 +504,28 @@ let _jit_hit = ref 0
 let _jit_miss = ref 0
 let _jit_skip = ref 0
 let jit_reset_counters () = _jit_hit := 0; _jit_miss := 0; _jit_skip := 0
+(* Sentinel value for "JIT skipped — fall back to CEK".
+   Must be distinguishable from any legitimate return value including Nil.
+   We use a unique tagged dict that is_jit_skip can identify. *)
+let _jit_skip_sentinel =
+  let d = Hashtbl.create 1 in
+  Hashtbl.replace d "__jit_skip" (Bool true);
+  Dict d
+
+let is_jit_skip v = match v with
+  | Dict d -> Hashtbl.mem d "__jit_skip"
+  | _ -> false
+
+(* Platform function for the spec: (jit-skip? v) → transpiles to jit_skip_p *)
+let jit_skip_p v = Bool (is_jit_skip v)
+
 let jit_try_call f args =
   match !_jit_try_call_fn with
-  | None -> incr _jit_skip; Nil
+  | None -> incr _jit_skip; _jit_skip_sentinel
   | Some hook ->
     match f with
     | Lambda l when l.l_name <> None ->
       let arg_list = match args with List a | ListRef { contents = a } -> a | _ -> [] in
-      (match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; Nil)
-    | _ -> incr _jit_skip; Nil
+      (match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; _jit_skip_sentinel)
+    | _ -> incr _jit_skip; _jit_skip_sentinel
 

hosts/ocaml/lib/sx_types.ml

@@ -178,6 +178,7 @@ and parameter = {
 (** Compiled function body — bytecode + constant pool. *)
 and vm_code = {
   vc_arity     : int;
+  vc_rest_arity : int;  (** -1 = no &rest; >= 0 = number of positional params before &rest *)
   vc_locals    : int;
   vc_bytecode  : int array;
   vc_constants : value array;
@@ -228,12 +229,50 @@ let _vm_call_closure_ref : (vm_closure -> value list -> value) ref =
 let _cek_call_ref : (value -> value -> value) ref =
   ref (fun _ _ -> raise (Failure "CEK call not initialized"))
 
+(** Forward ref: evaluate a Lambda via CEK (supports perform/suspension).
+    Set by sx_vm.ml to break the sx_runtime → sx_ref dependency cycle. *)
+let _cek_eval_lambda_ref : (value -> value list -> value) ref =
+  ref (fun _ _ -> raise (Failure "CEK eval lambda not initialized"))
+
 
 (** {1 Errors} *)
 
 exception Eval_error of string
 exception Parse_error of string
 
+(** Raised when a VmClosure hits OP_PERFORM inside a CEK evaluation.
+    The CEK step loop catches this and creates a proper io-suspended state
+    with the continuation preserved for resume. Defined here (not in sx_vm)
+    to avoid a dependency cycle between sx_runtime and sx_vm. *)
+exception CekPerformRequest of value
+
+(** Hook: resolve IO suspension inline in cek_run.
+    When set, cek_run calls this instead of raising "IO suspension in non-IO context".
+    The function receives the suspended state and returns the resolved value.
+    Used by the HTTP server to handle perform (text-measure) during aser. *)
+let _cek_io_resolver : (value -> value -> value) option ref = ref None
+
+(** Hook: handle CEK IO suspension in eval_expr (cek_run_iterative).
+    When set, called with the suspended CEK state instead of raising
+    "IO suspension in non-IO context". Used by the browser WASM kernel
+    to convert CEK suspensions to VmSuspended for _driveAsync handling. *)
+let _cek_io_suspend_hook : (value -> value) option ref = ref None
+
+(** Default VM globals for stub VMs created during IO suspension.
+    Set by sx_browser.ml to _vm_globals so CEK resume can access platform functions. *)
+let _default_vm_globals : (string, value) Hashtbl.t ref = ref (Hashtbl.create 0)
+
+(** Hook: convert VM suspension exceptions to CekPerformRequest.
+    Set by sx_vm after it defines VmSuspended. Called by sx_runtime.sx_apply_cek. *)
+let _convert_vm_suspension : (exn -> unit) ref = ref (fun _ -> ())
+
+(** Hook: convert VM suspension to a __vm_suspended marker dict.
+    Returns Some(dict) for VmSuspended, None otherwise.
+    The dict has keys: __vm_suspended, request, resume.
+    Used by sx_apply_cek so continue_with_call can build a proper
+    suspended CEK state with vm-resume-frame on the kont. *)
+let _vm_suspension_to_dict : (exn -> value option) ref = ref (fun _ -> None)
+
 
 (** {1 Record type descriptor table} *)
 
@@ -339,9 +378,21 @@ let env_merge base overlay =
 
 (** {1 Value extraction helpers} *)
 
+(** Format a float safely — defuse [int_of_float] overflow on huge
+    integer-valued floats, keep [%g] for fractions (unchanged). *)
+let format_number n =
+  if Float.is_nan n then "nan"
+  else if n = Float.infinity then "inf"
+  else if n = Float.neg_infinity then "-inf"
+  else if Float.is_integer n && Float.abs n < 1e16 then
+    string_of_int (int_of_float n)
+  else if Float.is_integer n then
+    Printf.sprintf "%.17g" n
+  else Printf.sprintf "%g" n
+
 let value_to_string = function
   | String s -> s | Symbol s -> s | Keyword k -> k
-  | Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n
+  | Number n -> format_number n
   | Bool true -> "true" | Bool false -> "false"
   | Nil -> "" | _ -> "<value>"
 
@@ -726,9 +777,7 @@ let rec inspect = function
   | Nil -> "nil"
   | Bool true -> "true"
   | Bool false -> "false"
-  | Number n ->
-    if Float.is_integer n then Printf.sprintf "%d" (int_of_float n)
-    else Printf.sprintf "%g" n
+  | Number n -> format_number n
   | String s ->
     let buf = Buffer.create (String.length s + 2) in
     Buffer.add_char buf '"';

hosts/ocaml/lib/sx_vm.ml

@@ -36,6 +36,7 @@ type vm = {
   globals        : (string, value) Hashtbl.t;  (* live reference to kernel env *)
   mutable pending_cek : value option;  (* suspended CEK state from Component/Lambda call *)
   mutable handler_stack : handler_entry list;  (* exception handler stack *)
+  mutable reuse_stack : (frame list * int) list;  (* saved call_closure_reuse continuations *)
 }
 
 (** Raised when OP_PERFORM is executed. Carries the IO request dict
@@ -43,6 +44,15 @@ type vm = {
     ip past OP_PERFORM, stack ready for a result push). *)
 exception VmSuspended of value * vm
 
+(* Register the VM suspension converter so sx_runtime.sx_apply_cek can
+   catch VmSuspended and convert it to CekPerformRequest without a
+   direct dependency on this module. *)
+let () = Sx_types._convert_vm_suspension := (fun exn ->
+  match exn with
+  | VmSuspended (request, _vm) -> raise (CekPerformRequest request)
+  | _ -> ())
+
+
 (** Forward reference for JIT compilation — set after definition. *)
 let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
   ref (fun _ _ -> None)
@@ -50,7 +60,7 @@ let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option)
 (** Sentinel closure indicating JIT compilation was attempted and failed.
     Prevents retrying compilation on every call. *)
 let jit_failed_sentinel = {
-  vm_code = { vc_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
+  vm_code = { vc_arity = -1; vc_rest_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
               vc_bytecode_list = None; vc_constants_list = None };
   vm_upvalues = [||]; vm_name = Some "__jit_failed__"; vm_env_ref = Hashtbl.create 0; vm_closure_env = None
 }
@@ -65,7 +75,7 @@ let is_jit_failed cl = cl.vm_code.vc_arity = -1
 let _active_vm : vm option ref = ref None
 
 let create globals =
-  { stack = Array.make 4096 Nil; sp = 0; frames = []; globals; pending_cek = None; handler_stack = [] }
+  { stack = Array.make 4096 Nil; sp = 0; frames = []; globals; pending_cek = None; handler_stack = []; reuse_stack = [] }
 
 (** Stack ops — inlined for speed. *)
 let push vm v =
@@ -133,38 +143,93 @@ let vm_report_counters () =
   Printf.eprintf "[vm-perf] insns=%d calls=%d cek_fallbacks=%d comp_jit=%d comp_cek=%d\n%!"
     !_vm_insn_count !_vm_call_count !_vm_cek_count !_vm_comp_jit_count !_vm_comp_cek_count
 
+(** Global flag: true while a JIT compilation is in progress.
+    Prevents the JIT hook from intercepting calls during compilation,
+    which would cause infinite cascades (compiling the compiler). *)
+let _jit_compiling = ref false
+
 (** Push a VM closure frame onto the current VM — no new VM allocation.
     This is the fast path for intra-VM closure calls. *)
 let push_closure_frame vm cl args =
   let frame = { closure = cl; ip = 0; base = vm.sp; local_cells = Hashtbl.create 4 } in
+  let rest_arity = cl.vm_code.vc_rest_arity in
+  if rest_arity >= 0 then begin
+    (* &rest function: push positional args, collect remainder into a list.
+       For (fn (a b &rest c) body) with rest_arity=2:
+         slots: 0=a, 1=b, 2=c (the rest list) *)
+    let nargs = List.length args in
+    let rec push_args i = function
+      | [] ->
+        for _ = i to rest_arity - 1 do push vm Nil done;
+        push vm (List [])
+      | a :: remaining ->
+        if i < rest_arity then (push vm a; push_args (i + 1) remaining)
+        else push vm (List (a :: remaining))
+    in
+    push_args 0 args;
+    let used = (if nargs > rest_arity then rest_arity + 1 else nargs + 1) in
+    for _ = used to cl.vm_code.vc_locals - 1 do push vm Nil done
+  end else begin
     List.iter (fun a -> push vm a) args;
-  for _ = List.length args to cl.vm_code.vc_locals - 1 do push vm Nil done;
+    for _ = List.length args to cl.vm_code.vc_locals - 1 do push vm Nil done
+  end;
   vm.frames <- frame :: vm.frames
 
 (** Convert compiler output (SX dict) to a vm_code object. *)
 let code_from_value v =
   match v with
   | Dict d ->
-    let bc_list = match Hashtbl.find_opt d "bytecode" with
+    (* Accept both compiler output keys (bytecode/constants/arity) and
+       SX vm-code keys (vc-bytecode/vc-constants/vc-arity) *)
+    let find2 k1 k2 = match Hashtbl.find_opt d k1 with
+      | Some _ as r -> r | None -> Hashtbl.find_opt d k2 in
+    let bc_list = match find2 "bytecode" "vc-bytecode" with
       | Some (List l | ListRef { contents = l }) ->
         Array.of_list (List.map (fun x -> match x with Number n -> int_of_float n | _ -> 0) l)
       | _ -> [||]
     in
-    let entries = match Hashtbl.find_opt d "constants" with
+    let entries = match find2 "constants" "vc-constants" with
       | Some (List l | ListRef { contents = l }) -> Array.of_list l
       | _ -> [||]
     in
     let constants = Array.map (fun entry ->
       match entry with
-      | Dict ed when Hashtbl.mem ed "bytecode" -> entry  (* nested code — convert lazily *)
+      | Dict ed when Hashtbl.mem ed "bytecode" || Hashtbl.mem ed "vc-bytecode" -> entry
       | _ -> entry
     ) entries in
-    let arity = match Hashtbl.find_opt d "arity" with
+    let arity = match find2 "arity" "vc-arity" with
       | Some (Number n) -> int_of_float n | _ -> 0
     in
-    { vc_arity = arity; vc_locals = arity + 16; vc_bytecode = bc_list; vc_constants = constants;
+    let rest_arity = match find2 "rest-arity" "vc-rest-arity" with
+      | Some (Number n) -> int_of_float n | _ -> -1
+    in
+    (* Compute locals from bytecode: scan for highest LOCAL_GET/LOCAL_SET slot.
+       The compiler's arity may undercount when nested lets add many locals. *)
+    let max_local = ref (arity - 1) in
+    let len = Array.length bc_list in
+    let i = ref 0 in
+    while !i < len do
+      let op = bc_list.(!i) in
+      if (op = 16 (* LOCAL_GET *) || op = 17 (* LOCAL_SET *)) && !i + 1 < len then
+        (let slot = bc_list.(!i + 1) in
+         if slot > !max_local then max_local := slot;
+         i := !i + 2)
+      else if op = 18 (* UPVALUE_GET *) || op = 19 (* UPVALUE_SET *)
+           || op = 8 (* JUMP_IF_FALSE *) || op = 33 (* JUMP_IF_FALSE_u16 *)
+           || op = 34 (* JUMP_IF_TRUE *) then
+        i := !i + 2
+      else if op = 1 (* CONST *) || op = 20 (* GLOBAL_GET *) || op = 21 (* GLOBAL_SET *)
+           || op = 32 (* JUMP *) || op = 51 (* CLOSURE *) || op = 52 (* CALL_PRIM *)
+           || op = 64 (* MAKE_LIST *) || op = 65 (* MAKE_DICT *) then
+        i := !i + 3  (* u16 operand *)
+      else
+        i := !i + 1
+    done;
+    let locals = !max_local + 1 + 16 in  (* +16 headroom for temporaries *)
+    { vc_arity = arity; vc_rest_arity = rest_arity; vc_locals = locals;
+      vc_bytecode = bc_list; vc_constants = constants;
       vc_bytecode_list = None; vc_constants_list = None }
-  | _ -> { vc_arity = 0; vc_locals = 16; vc_bytecode = [||]; vc_constants = [||];
+  | _ -> { vc_arity = 0; vc_rest_arity = -1; vc_locals = 16; vc_bytecode = [||]; vc_constants = [||];
            vc_bytecode_list = None; vc_constants_list = None }
 
 (** JIT-compile a component or island body.
@@ -205,9 +270,20 @@ let jit_compile_comp ~name ~params ~has_children ~body ~closure globals =
     Saves the suspended CEK state in vm.pending_cek for later resume. *)
 let cek_call_or_suspend vm f args =
   incr _vm_cek_count;
+  (* Removed debug trace *)
   let a = match args with Nil -> [] | List l -> l | _ -> [args] in
+  (* Replace _active_vm with an empty isolation VM so call_closure_reuse
+     inside the CEK pushes onto an empty frame stack rather than the caller's.
+     Without this, a VmClosure called from within the CEK (e.g. hs-wait)
+     merges frames with the caller's VM (e.g. do-repeat), and on resume
+     the VM skips the CEK's remaining continuation (wrong mutation order).
+     Using Some(isolation) rather than None keeps the call_closure_reuse
+     "Some" path which preserves exception identity in js_of_ocaml. *)
+  let saved_active = !_active_vm in
+  _active_vm := Some (create vm.globals);
   let state = Sx_ref.continue_with_call f (List a) (Env (Sx_types.make_env ())) (List a) (List []) in
   let final = Sx_ref.cek_step_loop state in
+  _active_vm := saved_active;
   match Sx_runtime.get_val final (String "phase") with
   | String "io-suspended" ->
     vm.pending_cek <- Some final;
@@ -228,8 +304,30 @@ let rec call_closure cl args globals =
 
 (** Call a VmClosure on the active VM if one exists, otherwise create a new one.
     This is the path used by HO primitives (map, filter, for-each, some) so
-    callbacks can access upvalues that reference the calling VM's state. *)
+    callbacks run on the same VM, avoiding per-call VM allocation overhead. *)
 and call_closure_reuse cl args =
+  match !_active_vm with
+  | Some vm ->
+    let saved_sp = vm.sp in
+    push_closure_frame vm cl args;
+    let saved_frames = List.tl vm.frames in
+    vm.frames <- [List.hd vm.frames];
+    (try run vm
+     with
+     | VmSuspended _ as e ->
+       (* IO suspension: save the caller's continuation on the reuse stack.
+          DON'T merge frames — that corrupts the frame chain with nested
+          closures. On resume, restore_reuse in resume_vm processes these
+          in innermost-first order after the callback finishes. *)
+       vm.reuse_stack <- (saved_frames, saved_sp) :: vm.reuse_stack;
+       raise e
+     | e ->
+       vm.frames <- saved_frames;
+       vm.sp <- saved_sp;
+       raise e);
+    vm.frames <- saved_frames;
+    pop vm
+  | None ->
     call_closure cl args cl.vm_env_ref
 
 (** Call a value as a function — dispatch by type.
@@ -247,25 +345,18 @@ and vm_call vm f args =
   | Lambda l ->
     (match l.l_compiled with
      | Some cl when not (is_jit_failed cl) ->
-       (* Cached bytecode — run on VM using the closure's captured env,
-          not the caller's globals. Closure vars were merged at compile time. *)
-       (try push vm (call_closure cl args cl.vm_env_ref)
-        with _e ->
-          (* Fallback to CEK — suspension-aware *)
-          push vm (cek_call_or_suspend vm f (List args)))
+       (* Cached bytecode — push frame on current VM *)
+       push_closure_frame vm cl args
      | Some _ ->
-       (* Compile failed — CEK, suspension-aware *)
        push vm (cek_call_or_suspend vm f (List args))
      | None ->
        if l.l_name <> None
        then begin
-         (* Pre-mark before compile attempt to prevent re-entrancy *)
          l.l_compiled <- Some jit_failed_sentinel;
          match !jit_compile_ref l vm.globals with
          | Some cl ->
            l.l_compiled <- Some cl;
-           (try push vm (call_closure cl args cl.vm_env_ref)
-            with _e -> push vm (cek_call_or_suspend vm f (List args)))
+           push_closure_frame vm cl args
          | None ->
            push vm (cek_call_or_suspend vm f (List args))
        end
@@ -360,6 +451,10 @@ and run vm =
         let op = bc.(frame.ip) in
         frame.ip <- frame.ip + 1;
         incr _vm_insn_count;
+        (* Check timeout — compare VM instruction count against step limit *)
+        if !_vm_insn_count land 0xFFFF = 0 && !Sx_ref.step_limit > 0
+           && !_vm_insn_count > !Sx_ref.step_limit then
+          raise (Eval_error "TIMEOUT: step limit exceeded");
         (try match op with
         (* ---- Constants ---- *)
         | 1 (* OP_CONST *) ->
@@ -426,7 +521,14 @@ and run vm =
             | None ->
               try Hashtbl.find vm.globals name with Not_found ->
                 try Sx_primitives.get_primitive name
-                with _ -> raise (Eval_error ("VM undefined: " ^ name))
+                with _ ->
+                  (* Try resolve hook — loads the library that exports this symbol *)
+                  (try
+                    let resolve_fn = Hashtbl.find vm.globals "__resolve-symbol" in
+                    ignore (Sx_runtime.sx_call resolve_fn [String name]);
+                    try Hashtbl.find vm.globals name
+                    with Not_found -> raise (Eval_error ("VM undefined: " ^ name))
+                  with Not_found -> raise (Eval_error ("VM undefined: " ^ name)))
           in
           push vm v
         | 21 (* OP_GLOBAL_SET *) ->
@@ -571,6 +673,11 @@ and run vm =
                  Primitives are seeded into vm.globals at init as NativeFn values.
                  OP_DEFINE and registerNative naturally override them. *)
               let fn_val = try Hashtbl.find vm.globals name with Not_found ->
+                (* Fallback to Sx_primitives — primitives registered AFTER JIT
+                   setup (e.g. host-global, host-get registered inside the test
+                   runner's bind/register path) are not in vm.globals. *)
+                try Sx_primitives.get_primitive name
+                with _ ->
                   raise (Eval_error ("VM: unknown primitive " ^ name))
               in
               (match fn_val with
@@ -732,23 +839,74 @@ and run vm =
   done
 
 (** Resume a suspended VM by pushing the IO result and continuing.
-    May raise VmSuspended again if the VM hits another OP_PERFORM. *)
+    May raise VmSuspended again if the VM hits another OP_PERFORM.
+
+    After the callback finishes, restores any call_closure_reuse
+    continuations saved on vm.reuse_stack (innermost first). *)
 let resume_vm vm result =
   (match vm.pending_cek with
    | Some cek_state ->
-     (* Resume the suspended CEK evaluation first *)
      vm.pending_cek <- None;
      let final = Sx_ref.cek_resume cek_state result in
      (match Sx_runtime.get_val final (String "phase") with
       | String "io-suspended" ->
-        (* CEK suspended again — re-suspend the VM *)
         vm.pending_cek <- Some final;
         raise (VmSuspended (Sx_runtime.get_val final (String "request"), vm))
       | _ ->
         push vm (Sx_ref.cek_value final))
    | None ->
      push vm result);
+  (try run vm
+   with
+   | VmSuspended _ as e ->
+     (* Re-suspension during resume: the VM hit another perform. *)
+     raise e
+   | Eval_error msg ->
+     (* Error during resumed execution. If the VM has a handler on its
+        handler_stack, dispatch to it (same as OP_RAISE). This enables
+        try/catch across async perform/resume boundaries — the handler
+        was pushed before the perform and survives on the vm struct. *)
+     (match vm.handler_stack with
+      | entry :: rest ->
+        vm.handler_stack <- rest;
+        while List.length vm.frames > entry.h_frame_depth do
+          match vm.frames with _ :: fs -> vm.frames <- fs | [] -> ()
+        done;
+        vm.sp <- entry.h_sp;
+        entry.h_frame.ip <- entry.h_catch_ip;
+        push vm (String msg);
+        run vm
+      | [] -> raise (Eval_error msg)));
+  (* Clear reuse_stack — any entries here are stale from the original
+     suspension and don't apply to the current state. The VM just
+     completed its execution successfully. *)
+  vm.reuse_stack <- [];
+  (* Restore call_closure_reuse continuations saved during suspension.
+     reuse_stack is in catch order (outermost first from prepend) —
+     reverse to get innermost first, matching callback→caller unwinding. *)
+  let rec restore_reuse pending =
+    match pending with
+    | [] -> ()
+    | (saved_frames, _saved_sp) :: rest ->
+      let callback_result = pop vm in
+      vm.frames <- saved_frames;
+      push vm callback_result;
+      (try
         run vm;
+        (* Check for new reuse entries added by nested call_closure_reuse *)
+        let new_pending = List.rev vm.reuse_stack in
+        vm.reuse_stack <- [];
+        restore_reuse (new_pending @ rest)
+      with VmSuspended _ as e ->
+        (* Re-suspension: save unprocessed entries back for next resume.
+           rest is innermost-first; vm.reuse_stack is outermost-first.
+           Combine so next resume's reversal yields: new_inner, old_inner→outer. *)
+        vm.reuse_stack <- (List.rev rest) @ vm.reuse_stack;
+        raise e)
+  in
+  let pending = List.rev vm.reuse_stack in
+  vm.reuse_stack <- [];
+  restore_reuse pending;
   pop vm
 
 (** Execute a compiled module (top-level bytecode). *)
@@ -782,33 +940,91 @@ let execute_module_safe code globals =
     The compilation cost is a single CEK evaluation of the compiler —
     microseconds per function. The result is cached in the lambda/component
     record so subsequent calls go straight to the VM. *)
+(* Functions whose JIT bytecode is known broken (see project_jit_bytecode_bug):
+   parser combinators drop intermediate results, the hyperscript parse/compile
+   stack corrupts ASTs when compiled, and test-orchestration helpers have
+   call-count/arg-shape mismatches vs CEK. These must run under CEK. *)
+let _jit_is_broken_name n =
+  (* Parser combinators *)
+  n = "parse-bind" || n = "seq" || n = "seq2" || n = "many" || n = "many1"
+  || n = "satisfy" || n = "fmap" || n = "alt" || n = "alt2"
+  || n = "skip-left" || n = "skip-right" || n = "skip-many" || n = "optional"
+  || n = "between" || n = "sep-by" || n = "sep-by1" || n = "parse-char"
+  || n = "parse-string" || n = "lazy-parser" || n = "label"
+  || n = "not-followed-by" || n = "look-ahead"
+  (* Hyperscript orchestrators — call parser combinators *)
+  || n = "hs-tokenize" || n = "hs-parse" || n = "hs-compile"
+  || n = "hs-to-sx" || n = "hs-to-sx-from-source"
+  (* Test orchestration helpers *)
+  || n = "eval-hs" || n = "eval-hs-inner" || n = "eval-hs-with-me"
+  || n = "run-hs-fixture"
+  (* Large top-level functions whose JIT compile exceeds the 5s test
+     deadline — tw-resolve-style, tw-resolve-layout, graphql parse. *)
+  || n = "tw-resolve-style" || n = "tw-resolve-layout"
+  || n = "gql-ws?" || n = "gql-parse-tokens" || n = "gql-execute-operation"
+  (* Hyperscript loop runtime: uses `guard` to catch hs-break/hs-continue
+     exceptions. JIT-compiled guard drops the exception handler such that
+     break propagates out of the click handler instead of exiting the loop.
+     See hs-upstream-repeat/hs-upstream-put tests. *)
+  || n = "hs-repeat-times" || n = "hs-repeat-forever"
+  || n = "hs-repeat-while" || n = "hs-repeat-until"
+  || n = "hs-for-each" || n = "hs-put!"
+
 let jit_compile_lambda (l : lambda) globals =
   let fn_name = match l.l_name with Some n -> n | None -> "<anon>" in
+  if !_jit_compiling then (
+    (* Already compiling — prevent cascade. The CEK will handle this call. *)
+    None
+  ) else if List.mem "&key" l.l_params || List.mem ":as" l.l_params then (
+    (* &key/:as require complex runtime argument processing that the compiler
+       doesn't emit. These functions must run via CEK. *)
+    None
+  ) else if l.l_name = None || l.l_closure.Sx_types.parent <> None then (
+    (* Anonymous or nested lambdas: skip JIT. Nested defines get re-created
+       on each outer call, so per-call compile cost is pure overhead. *)
+    None
+  ) else if _jit_is_broken_name fn_name then (
+    None
+  ) else
   try
+    _jit_compiling := true;
     let compile_fn = try Hashtbl.find globals "compile"
-      with Not_found -> raise (Eval_error "JIT: compiler not loaded") in
-    (* Reconstruct the (fn (params) body) form so the compiler produces
-       a proper closure. l.l_body is the inner body; we need the full
-       function form with params so the compiled code binds them. *)
+      with Not_found -> (_jit_compiling := false; raise (Eval_error "JIT: compiler not loaded")) in
     let param_syms = List (List.map (fun s -> Symbol s) l.l_params) in
     let fn_expr = List [Symbol "fn"; param_syms; l.l_body] in
     let quoted = List [Symbol "quote"; fn_expr] in
-    (* Use Symbol "compile" so the CEK resolves it from the env, not
-       an embedded VmClosure value — the CEK dispatches VmClosure calls
-       differently when the value is resolved from env vs embedded in AST. *)
+    (* Fast path: if compile has bytecode, call it directly via the VM.
+       All helper calls (compile-expr, emit-byte, etc.) happen inside the
+       same VM execution — no per-call VM allocation overhead. *)
+    let result = match compile_fn with
+    | Lambda { l_compiled = Some cl; _ } when not (is_jit_failed cl) ->
+      call_closure cl [fn_expr] globals
+    | _ ->
       ignore compile_fn;
       let compile_env = Sx_types.env_extend (Sx_types.make_env ()) in
       Hashtbl.iter (fun k v -> Hashtbl.replace compile_env.bindings (Sx_types.intern k) v) globals;
-    let result = Sx_ref.eval_expr (List [Symbol "compile"; quoted]) (Env compile_env) in
-    (* Closure vars are accessible via vm_closure_env (set on the VmClosure
-       at line ~617). OP_GLOBAL_GET falls back to vm_closure_env when vars
-       aren't in globals. No injection into the shared globals table —
-       that would break closure isolation for factory functions like
-       make-page-fn where multiple closures capture different values
-       for the same variable names. *)
-    let effective_globals = globals in
+      Sx_ref.eval_expr (List [Symbol "compile"; quoted]) (Env compile_env)
+    in
+    _jit_compiling := false;
+    (* Merge closure bindings into effective_globals so GLOBAL_GET resolves
+       variables from let/define blocks. The compiler emits GLOBAL_GET for
+       free variables; the VM resolves them from vm_env_ref. *)
+    let effective_globals =
+      if Hashtbl.length l.l_closure.Sx_types.bindings > 0 then begin
+        let merged = Hashtbl.copy globals in
+        let rec merge_env env =
+          Hashtbl.iter (fun id v ->
+            let name = Sx_types.unintern id in
+            if not (Hashtbl.mem merged name) then
+              Hashtbl.replace merged name v) env.Sx_types.bindings;
+          match env.Sx_types.parent with Some p -> merge_env p | None -> ()
+        in
+        merge_env l.l_closure;
+        merged
+      end else globals
+    in
     (match result with
-    | Dict d when Hashtbl.mem d "bytecode" ->
+    | Dict d when Hashtbl.mem d "bytecode" || Hashtbl.mem d "vc-bytecode" ->
       let outer_code = code_from_value result in
       let bc = outer_code.vc_bytecode in
       if Array.length bc >= 4 && bc.(0) = 51 (* OP_CLOSURE *) then begin
@@ -821,21 +1037,13 @@ let jit_compile_lambda (l : lambda) globals =
         else begin
           Printf.eprintf "[jit] FAIL %s: closure index %d out of bounds (pool=%d)\n%!"
             fn_name idx (Array.length outer_code.vc_constants);
-
           None
         end
       end else begin
-        (* Not a closure — constant expression, alias, or simple computation.
-           Execute the bytecode as a module to get the value, then wrap
-           as a NativeFn if it's callable (so the CEK can dispatch to it). *)
         (try
           let value = execute_module outer_code globals in
           Printf.eprintf "[jit] RESOLVED %s: %s (bc[0]=%d)\n%!"
             fn_name (type_of value) (if Array.length bc > 0 then bc.(0) else -1);
-          (* If the resolved value is a NativeFn, we can't wrap it as a
-             vm_closure — just let the CEK handle it directly. Return None
-             so the lambda falls through to CEK, which will find the
-             resolved value in the env on next lookup. *)
           None
         with _ ->
           Printf.eprintf "[jit] SKIP %s: non-closure execution failed (bc[0]=%d, len=%d)\n%!"
@@ -846,12 +1054,73 @@ let jit_compile_lambda (l : lambda) globals =
       Printf.eprintf "[jit] FAIL %s: compiler returned %s\n%!" fn_name (type_of result);
       None)
   with e ->
+    _jit_compiling := false;
     Printf.eprintf "[jit] FAIL %s: %s\n%!" fn_name (Printexc.to_string e);
     None
 
 (* Wire up forward references *)
 let () = jit_compile_ref := jit_compile_lambda
-let () = _vm_call_closure_ref := (fun cl args -> call_closure cl args cl.vm_env_ref)
+let () = _vm_call_closure_ref := (fun cl args -> call_closure_reuse cl args)
+let () = _vm_suspension_to_dict := (fun exn ->
+  match exn with
+  | VmSuspended (request, vm) ->
+    (* Snapshot pending_cek and reuse_stack NOW — a nested cek_call_or_suspend
+       on the same VM may overwrite them before our resume function is called. *)
+    let saved_cek = vm.pending_cek in
+    let saved_reuse = vm.reuse_stack in
+    let d = Hashtbl.create 3 in
+    Hashtbl.replace d "__vm_suspended" (Bool true);
+    Hashtbl.replace d "request" request;
+    Hashtbl.replace d "resume" (NativeFn ("vm-resume", fun args ->
+      match args with
+      | [result] ->
+        (* Restore saved state before resuming — may have been overwritten
+           by a nested suspension on the same VM. *)
+        vm.pending_cek <- saved_cek;
+        vm.reuse_stack <- saved_reuse;
+        (try resume_vm vm result
+         with exn2 ->
+           match !_vm_suspension_to_dict exn2 with
+           | Some marker -> marker
+           | None -> raise exn2)
+      | _ -> Nil));
+    Some (Dict d)
+  | _ -> None)
+(* Hook: when eval_expr (cek_run_iterative) encounters a CEK suspension,
+   convert it to VmSuspended so it propagates to the outer handler
+   (value_to_js wrapper, _driveAsync, etc.). Without this, perform
+   inside nested eval_expr calls (event handler → trampoline → eval_expr)
+   gets swallowed as "IO suspension in non-IO context". *)
+let () = _cek_io_suspend_hook := Some (fun suspended_state ->
+  let request = Sx_ref.cek_io_request suspended_state in
+  let vm = create !_default_vm_globals in
+  vm.pending_cek <- Some suspended_state;
+  (* Transfer reuse_stack from the active VM so resume_vm can restore
+     caller frames saved by call_closure_reuse during the suspension chain. *)
+  (match !_active_vm with
+   | Some active when active.reuse_stack <> [] ->
+     vm.reuse_stack <- active.reuse_stack;
+     active.reuse_stack <- []
+   | _ -> ());
+  raise (VmSuspended (request, vm)))
+
+let () = _cek_eval_lambda_ref := (fun f args ->
+  let state = Sx_ref.continue_with_call f (List args) (Env (make_env ())) (List args) (List []) in
+  let final = Sx_ref.cek_step_loop state in
+  match Sx_runtime.get_val final (String "phase") with
+  | String "io-suspended" ->
+    (* Create a stub VM to carry the suspended CEK state.
+       resume_vm will: cek_resume → push result → run (no-op, no frames) → pop *)
+    let vm = create (Hashtbl.create 0) in
+    vm.pending_cek <- Some final;
+    (* Transfer reuse_stack from active VM *)
+    (match !_active_vm with
+     | Some active when active.reuse_stack <> [] ->
+       vm.reuse_stack <- active.reuse_stack;
+       active.reuse_stack <- []
+     | _ -> ());
+    raise (VmSuspended (Sx_runtime.get_val final (String "request"), vm))
+  | _ -> Sx_ref.cek_value final)
 
 
 (** {1 Debugging / introspection} *)

hosts/ocaml/lib/sx_vm_ref.ml

@@ -292,7 +292,7 @@ let vm_create_closure vm_val frame_val code_val =
 
 (* --- JIT sentinel --- *)
 let _jit_failed_sentinel = {
-  vm_code = { vc_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
+  vm_code = { vc_arity = -1; vc_rest_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
               vc_bytecode_list = None; vc_constants_list = None };
   vm_upvalues = [||]; vm_name = Some "__jit_failed__"; vm_env_ref = Hashtbl.create 0; vm_closure_env = None
 }

hosts/ocaml/shared/static/wasm/sx-platform.js

@@ -0,0 +1,749 @@
+/**
+ * sx-platform.js — Browser platform layer for the SX WASM kernel.
+ *
+ * Registers the 8 FFI host primitives and loads web adapter .sx files.
+ * This is the only JS needed beyond the WASM kernel itself.
+ *
+ * Usage:
+ *   <script src="sx_browser.bc.wasm.js"></script>
+ *   <script src="sx-platform.js"></script>
+ *
+ * Or for js_of_ocaml mode:
+ *   <script src="sx_browser.bc.js"></script>
+ *   <script src="sx-platform.js"></script>
+ */
+
+(function() {
+  "use strict";
+
+  function boot(K) {
+
+  // ================================================================
+  // FFI Host Primitives
+  // ================================================================
+
+  // Lazy module loading — islands/components call this to declare dependencies
+  K.registerNative("load-library!", function(args) {
+    var name = args[0];
+    if (!name) return false;
+    return __sxLoadLibrary(name) || false;
+  });
+
+  K.registerNative("host-global", function(args) {
+    var name = args[0];
+    if (typeof globalThis !== "undefined" && name in globalThis) return globalThis[name];
+    if (typeof window !== "undefined" && name in window) return window[name];
+    return null;
+  });
+
+  K.registerNative("host-get", function(args) {
+    var obj = args[0], prop = args[1];
+    if (obj == null) return null;
+    var v = obj[prop];
+    if (v === undefined) return null;
+    // Functions can't cross the WASM boundary — return true as a truthy
+    // sentinel so (host-get el "getAttribute") works as a guard.
+    // Use host-call to actually invoke the method.
+    if (typeof v === "function") return true;
+    return v;
+  });
+
+  K.registerNative("host-set!", function(args) {
+    var obj = args[0], prop = args[1], val = args[2];
+    if (obj != null) obj[prop] = val;
+  });
+
+  K.registerNative("host-call", function(args) {
+    var obj = args[0], method = args[1];
+    var callArgs = [];
+    for (var i = 2; i < args.length; i++) callArgs.push(args[i]);
+    if (obj == null) {
+      // Global function call
+      var fn = typeof globalThis !== "undefined" ? globalThis[method] : window[method];
+      if (typeof fn === "function") return fn.apply(null, callArgs);
+      return null;
+    }
+    if (typeof obj[method] === "function") {
+      try { return obj[method].apply(obj, callArgs); }
+      catch(e) { console.error("[sx] host-call error:", e); return null; }
+    }
+    return null;
+  });
+
+  K.registerNative("host-new", function(args) {
+    var name = args[0];
+    var cArgs = args.slice(1);
+    var Ctor = typeof globalThis !== "undefined" ? globalThis[name] : window[name];
+    if (typeof Ctor !== "function") return null;
+    switch (cArgs.length) {
+      case 0: return new Ctor();
+      case 1: return new Ctor(cArgs[0]);
+      case 2: return new Ctor(cArgs[0], cArgs[1]);
+      case 3: return new Ctor(cArgs[0], cArgs[1], cArgs[2]);
+      default: return new Ctor(cArgs[0], cArgs[1], cArgs[2], cArgs[3]);
+    }
+  });
+
+  // IO suspension driver — resumes suspended callFn results (wait, fetch, etc.)
+  if (!window._driveAsync) {
+    window._driveAsync = function driveAsync(result) {
+      if (!result || !result.suspended) return;
+      var req = result.request;
+      var items = req && (req.items || req);
+      var op = items && items[0];
+      var opName = typeof op === "string" ? op : (op && op.name) || String(op);
+      var arg = items && items[1];
+      if (opName === "io-sleep" || opName === "wait") {
+        setTimeout(function() {
+          try { driveAsync(result.resume(null)); } catch(e) { console.error("[sx] driveAsync:", e.message); }
+        }, typeof arg === "number" ? arg : 0);
+      } else if (opName === "io-fetch") {
+        fetch(typeof arg === "string" ? arg : "").then(function(r) { return r.text(); }).then(function(t) {
+          try { driveAsync(result.resume({ok: true, text: t})); } catch(e) { console.error("[sx] driveAsync:", e.message); }
+        });
+      } else if (opName === "io-navigate") {
+        // navigation — don't resume
+      } else {
+        console.warn("[sx] unhandled IO:", opName);
+      }
+    };
+  }
+
+  K.registerNative("host-callback", function(args) {
+    var fn = args[0];
+    // Native JS function — pass through
+    if (typeof fn === "function") return fn;
+    // SX callable (has __sx_handle) — wrap as JS function
+    if (fn && fn.__sx_handle !== undefined) {
+      return function() {
+        var a = Array.prototype.slice.call(arguments);
+        var r = K.callFn(fn, a);
+        if (window._driveAsync) window._driveAsync(r);
+        return r;
+      };
+    }
+    return function() {};
+  });
+
+  K.registerNative("host-typeof", function(args) {
+    var obj = args[0];
+    if (obj == null) return "nil";
+    if (obj instanceof Element) return "element";
+    if (obj instanceof Text) return "text";
+    if (obj instanceof DocumentFragment) return "fragment";
+    if (obj instanceof Document) return "document";
+    if (obj instanceof Event) return "event";
+    if (obj instanceof Promise) return "promise";
+    if (obj instanceof AbortController) return "abort-controller";
+    return typeof obj;
+  });
+
+  K.registerNative("host-await", function(args) {
+    var promise = args[0], callback = args[1];
+    if (promise && typeof promise.then === "function") {
+      var cb;
+      if (typeof callback === "function") cb = callback;
+      else if (callback && callback.__sx_handle !== undefined)
+        cb = function(v) { return K.callFn(callback, [v]); };
+      else cb = function() {};
+      promise.then(cb);
+    }
+  });
+
+  // ================================================================
+  // Constants expected by .sx files
+  // ================================================================
+
+  K.eval('(define SX_VERSION "wasm-1.0")');
+  K.eval('(define SX_ENGINE "ocaml-vm-wasm")');
+  K.eval('(define parse sx-parse)');
+  K.eval('(define serialize sx-serialize)');
+
+  // ================================================================
+  // DOM query helpers used by boot.sx / orchestration.sx
+  // (These are JS-native in the transpiled bundle; here via FFI.)
+  // ================================================================
+
+  K.registerNative("query-sx-scripts", function(args) {
+    var root = (args[0] && args[0] !== null) ? args[0] : document;
+    if (typeof root.querySelectorAll !== "function") root = document;
+    return Array.prototype.slice.call(root.querySelectorAll('script[type="text/sx"]'));
+  });
+
+  K.registerNative("query-page-scripts", function(args) {
+    return Array.prototype.slice.call(document.querySelectorAll('script[type="text/sx-pages"]'));
+  });
+
+  K.registerNative("query-component-scripts", function(args) {
+    var root = (args[0] && args[0] !== null) ? args[0] : document;
+    if (typeof root.querySelectorAll !== "function") root = document;
+    return Array.prototype.slice.call(root.querySelectorAll('script[type="text/sx"][data-components]'));
+  });
+
+  // localStorage
+  K.registerNative("local-storage-get", function(args) {
+    try { var v = localStorage.getItem(args[0]); return v === null ? null : v; }
+    catch(e) { return null; }
+  });
+  K.registerNative("local-storage-set", function(args) {
+    try { localStorage.setItem(args[0], args[1]); } catch(e) {}
+  });
+  K.registerNative("local-storage-remove", function(args) {
+    try { localStorage.removeItem(args[0]); } catch(e) {}
+  });
+
+  // log-info/log-warn defined in browser.sx; log-error as native fallback
+  K.registerNative("log-error", function(args) { console.error.apply(console, ["[sx]"].concat(args)); });
+
+  // Cookie access (browser-side)
+  K.registerNative("get-cookie", function(args) {
+    var name = args[0];
+    var match = document.cookie.match(new RegExp('(?:^|; )' + name.replace(/[.*+?^${}()|[\]\\]/g, '\\$&') + '=([^;]*)'));
+    return match ? decodeURIComponent(match[1]) : null;
+  });
+  K.registerNative("set-cookie", function(args) {
+    document.cookie = args[0] + "=" + encodeURIComponent(args[1] || "") + ";path=/;max-age=31536000;SameSite=Lax";
+  });
+
+  // IntersectionObserver — native JS to avoid bytecode callback issues
+  K.registerNative("observe-intersection", function(args) {
+    var el = args[0], callback = args[1], once = args[2], delay = args[3];
+    var obs = new IntersectionObserver(function(entries) {
+      for (var i = 0; i < entries.length; i++) {
+        if (entries[i].isIntersecting) {
+          var d = (delay && delay !== null) ? delay : 0;
+          setTimeout(function() { K.callFn(callback, []); }, d);
+          if (once) obs.unobserve(el);
+        }
+      }
+    });
+    obs.observe(el);
+    return obs;
+  });
+
+  // ================================================================
+  // Load SX web libraries and adapters
+  // ================================================================
+
+  // Load order follows dependency graph:
+  //   1. Core spec files (parser, render, primitives already compiled into WASM kernel)
+  //   2. Spec modules: signals, deps, router, page-helpers
+  //   3. Bytecode compiler + VM (for JIT in browser)
+  //   4. Web libraries: dom.sx, browser.sx (built on 8 FFI primitives)
+  //   5. Web adapters: adapter-html, adapter-sx, adapter-dom
+  //   6. Web framework: engine, orchestration, boot
+
+  var _baseUrl = "";
+
+  // Detect base URL and cache-bust params from current script tag.
+  // _cacheBust comes from the script's own ?v= query string (used for .sx source fallback).
+  // _sxbcCacheBust comes from data-sxbc-hash attribute — a separate content hash
+  // covering all .sxbc files so each file gets its own correct cache buster.
+  var _cacheBust = "";
+  var _sxbcCacheBust = "";
+  (function() {
+    if (typeof document !== "undefined") {
+      var scripts = document.getElementsByTagName("script");
+      for (var i = scripts.length - 1; i >= 0; i--) {
+        var src = scripts[i].src || "";
+        if (src.indexOf("sx-platform") !== -1) {
+          _baseUrl = src.substring(0, src.lastIndexOf("/") + 1);
+          var qi = src.indexOf("?");
+          if (qi !== -1) _cacheBust = src.substring(qi);
+          var sxbcHash = scripts[i].getAttribute("data-sxbc-hash");
+          if (sxbcHash) _sxbcCacheBust = "?v=" + sxbcHash;
+          break;
+        }
+      }
+    }
+  })();
+
+  /**
+   * Deserialize type-tagged JSON constant back to JS value for loadModule.
+   */
+  function deserializeConstant(c) {
+    if (!c || !c.t) return null;
+    switch (c.t) {
+      case 's': return c.v;
+      case 'n': return c.v;
+      case 'b': return c.v;
+      case 'nil': return null;
+      case 'sym': return { _type: 'symbol', name: c.v };
+      case 'kw':  return { _type: 'keyword', name: c.v };
+      case 'list': return { _type: 'list', items: (c.v || []).map(deserializeConstant) };
+      case 'code': return {
+        _type: 'dict',
+        bytecode: { _type: 'list', items: c.v.bytecode },
+        constants: { _type: 'list', items: (c.v.constants || []).map(deserializeConstant) },
+        arity: c.v.arity || 0,
+        'upvalue-count': c.v['upvalue-count'] || 0,
+        locals: c.v.locals || 0,
+      };
+      case 'dict': {
+        var d = { _type: 'dict' };
+        for (var k in c.v) d[k] = deserializeConstant(c.v[k]);
+        return d;
+      }
+      default: return null;
+    }
+  }
+
+  /**
+   * Convert a parsed SX code form ({_type:"list", items:[symbol"code", ...]})
+   * into the dict format that K.loadModule / js_to_value expects.
+   * Mirrors the OCaml convert_code/convert_const in sx_browser.ml.
+   */
+  function convertCodeForm(form) {
+    if (!form || form._type !== "list" || !form.items || !form.items.length) return null;
+    var items = form.items;
+    if (!items[0] || items[0]._type !== "symbol" || items[0].name !== "code") return null;
+
+    var d = { _type: "dict", arity: 0, "upvalue-count": 0 };
+    for (var i = 1; i < items.length; i++) {
+      var item = items[i];
+      if (item && item._type === "keyword" && i + 1 < items.length) {
+        var val = items[i + 1];
+        if (item.name === "arity" || item.name === "upvalue-count") {
+          d[item.name] = (typeof val === "number") ? val : 0;
+        } else if (item.name === "bytecode" && val && val._type === "list") {
+          d.bytecode = val;  // {_type:"list", items:[numbers...]}
+        } else if (item.name === "constants" && val && val._type === "list") {
+          d.constants = { _type: "list", items: (val.items || []).map(convertConst) };
+        }
+        i++; // skip value
+      }
+    }
+    return d;
+  }
+
+  function convertConst(c) {
+    if (!c || typeof c !== "object") return c; // number, string, boolean, null pass through
+    if (c._type === "list" && c.items && c.items.length > 0) {
+      var head = c.items[0];
+      if (head && head._type === "symbol" && head.name === "code") {
+        return convertCodeForm(c);
+      }
+      if (head && head._type === "symbol" && head.name === "list") {
+        return { _type: "list", items: c.items.slice(1).map(convertConst) };
+      }
+    }
+    return c; // symbols, keywords, etc. pass through
+  }
+
+  /**
+   * Try loading a pre-compiled .sxbc bytecode module (SX text format).
+   * Uses K.loadModule which handles VM suspension (import requests).
+   * Returns true on success, null on failure (caller falls back to .sx source).
+   */
+  function loadBytecodeFile(path) {
+    var sxbcPath = path.replace(/\.sx$/, '.sxbc');
+    var url = _baseUrl + sxbcPath + _sxbcCacheBust;
+    try {
+      var xhr = new XMLHttpRequest();
+      xhr.open("GET", url, false);
+      xhr.send();
+      if (xhr.status !== 200) return null;
+
+      // Parse the sxbc text to get the SX tree
+      var parsed = K.parse(xhr.responseText);
+      if (!parsed || !parsed.length) return null;
+      var sxbc = parsed[0]; // (sxbc version hash (code ...))
+      if (!sxbc || sxbc._type !== "list" || !sxbc.items) return null;
+
+      // Extract the code form — 3rd or 4th item (after sxbc, version, optional hash)
+      var codeForm = null;
+      for (var i = 1; i < sxbc.items.length; i++) {
+        var item = sxbc.items[i];
+        if (item && item._type === "list" && item.items && item.items.length > 0 &&
+            item.items[0] && item.items[0]._type === "symbol" && item.items[0].name === "code") {
+          codeForm = item;
+          break;
+        }
+      }
+      if (!codeForm) return null;
+
+      // Convert the SX code form to a dict for loadModule
+      var moduleDict = convertCodeForm(codeForm);
+      if (!moduleDict) return null;
+
+      // Load via K.loadModule which handles VmSuspended
+      var result = K.loadModule(moduleDict);
+
+      // Handle import suspensions — fetch missing libraries on demand
+      while (result && result.suspended && result.op === "import") {
+        var req = result.request;
+        var libName = req && req.library;
+        if (libName) {
+          // Try to find and load the library from the manifest
+          var loaded = handleImportSuspension(libName);
+          if (!loaded) {
+            console.warn("[sx-platform] lazy import: library not found:", libName);
+          }
+        }
+        // Resume the suspended module (null = library is now in env)
+        result = result.resume(null);
+      }
+
+      if (typeof result === 'string' && result.indexOf('Error') === 0) {
+        console.warn("[sx-platform] bytecode FAIL " + path + ":", result);
+        return null;
+      }
+      return true;
+    } catch(e) {
+      console.warn("[sx-platform] bytecode FAIL " + path + ":", e.message || e);
+      return null;
+    }
+  }
+
+  /**
+   * Handle an import suspension by finding and loading the library.
+   * The library name may be an SX value (list/string) — normalize to manifest key.
+   */
+  function handleImportSuspension(libSpec) {
+    // libSpec from the kernel is the library name spec, e.g. {_type:"list", items:[{name:"sx"},{name:"dom"}]}
+    // or a string like "sx dom"
+    var key;
+    if (typeof libSpec === "string") {
+      key = libSpec;
+    } else if (libSpec && libSpec._type === "list" && libSpec.items) {
+      key = libSpec.items.map(function(item) {
+        return (item && item.name) ? item.name : String(item);
+      }).join(" ");
+    } else if (libSpec && libSpec._type === "dict") {
+      // Dict with key/name fields
+      key = libSpec.key || libSpec.name || "";
+    } else {
+      key = String(libSpec);
+    }
+
+    if (_loadedLibs[key]) return true; // already loaded
+
+    if (!_manifest) loadManifest();
+    if (!_manifest || !_manifest[key]) {
+      console.warn("[sx-platform] lazy import: unknown library key '" + key + "'");
+      return false;
+    }
+
+    // Load the library (and its deps) on demand
+    return loadLibrary(key, {});
+  }
+
+  /**
+   * Load an .sx file synchronously via XHR (boot-time only).
+   * Returns the number of expressions loaded, or an error string.
+   */
+  function loadSxFile(path) {
+    var url = _baseUrl + path + _cacheBust;
+    try {
+      var xhr = new XMLHttpRequest();
+      xhr.open("GET", url, false); // synchronous
+      xhr.send();
+      if (xhr.status === 200) {
+        var result = K.load(xhr.responseText);
+        if (typeof result === "string" && result.indexOf("Error") === 0) {
+          console.error("[sx-platform] FAIL " + path + ":", result);
+          return 0;
+        }
+        console.log("[sx-platform]  ok " + path + " (" + result + " exprs)");
+        return result;
+      } else {
+        console.error("[sx] Failed to fetch " + path + ": HTTP " + xhr.status);
+        return null;
+      }
+    } catch(e) {
+      console.error("[sx] Failed to load " + path + ":", e);
+      return null;
+    }
+  }
+
+  // ================================================================
+  // Manifest-driven module loader — only loads what's needed
+  // ================================================================
+
+  var _manifest = null;
+  var _loadedLibs = {};
+
+  /**
+   * Fetch and parse the module manifest (library deps + file paths).
+   */
+  function loadManifest() {
+    if (_manifest) return _manifest;
+    try {
+      var xhr = new XMLHttpRequest();
+      xhr.open("GET", _baseUrl + "sx/module-manifest.json" + _cacheBust, false);
+      xhr.send();
+      if (xhr.status === 200) {
+        _manifest = JSON.parse(xhr.responseText);
+        return _manifest;
+      }
+    } catch(e) {}
+    console.warn("[sx-platform] No manifest found, falling back to full load");
+    return null;
+  }
+
+  /**
+   * Load a single library and all its dependencies (recursive).
+   * Cycle-safe: tracks in-progress loads to break circular deps.
+   * Functions in cyclic modules resolve symbols at call time via global env.
+   */
+  function loadLibrary(name, loading) {
+    if (_loadedLibs[name]) return true;
+    if (loading[name]) return true; // cycle — skip
+    loading[name] = true;
+
+    var info = _manifest[name];
+    if (!info) {
+      console.warn("[sx-platform] Unknown library: " + name);
+      return false;
+    }
+
+    // Resolve deps first
+    for (var i = 0; i < info.deps.length; i++) {
+      loadLibrary(info.deps[i], loading);
+    }
+
+    // Mark as loaded BEFORE executing — self-imports (define-library re-exports)
+    // will see it as already loaded and skip rather than infinite-looping.
+    _loadedLibs[name] = true;
+
+    // Load this module (bytecode first, fallback to source)
+    var ok = loadBytecodeFile("sx/" + info.file);
+    if (!ok) {
+      var sxFile = info.file.replace(/\.sxbc$/, '.sx');
+      ok = loadSxFile("sx/" + sxFile);
+    }
+    return !!ok;
+  }
+
+  /**
+   * Load web stack using the module manifest.
+   * Only downloads libraries that the entry point transitively depends on.
+   */
+  function loadWebStack() {
+    var manifest = loadManifest();
+    if (!manifest) return loadWebStackFallback();
+
+    var entry = manifest["_entry"];
+    if (!entry) {
+      console.warn("[sx-platform] No _entry in manifest, falling back");
+      return loadWebStackFallback();
+    }
+
+    var loading = {};
+    var t0 = performance.now();
+    if (K.beginModuleLoad) K.beginModuleLoad();
+
+    // Load all entry point deps recursively
+    for (var i = 0; i < entry.deps.length; i++) {
+      loadLibrary(entry.deps[i], loading);
+    }
+
+    // Load entry point itself (boot.sx — not a library, just defines + init)
+    loadBytecodeFile("sx/" + entry.file) || loadSxFile("sx/" + entry.file.replace(/\.sxbc$/, '.sx'));
+
+    if (K.endModuleLoad) K.endModuleLoad();
+    var count = Object.keys(_loadedLibs).length + 1; // +1 for entry
+    var dt = Math.round(performance.now() - t0);
+    console.log("[sx-platform] Loaded " + count + " modules in " + dt + "ms (manifest-driven)");
+  }
+
+  /**
+   * Fallback: load all files in hardcoded order (pre-manifest compat).
+   */
+  function loadWebStackFallback() {
+    var files = [
+      "sx/render.sx", "sx/core-signals.sx", "sx/signals.sx", "sx/deps.sx",
+      "sx/router.sx", "sx/page-helpers.sx", "sx/freeze.sx", "sx/highlight.sx",
+      "sx/bytecode.sx", "sx/compiler.sx", "sx/vm.sx", "sx/dom.sx", "sx/browser.sx",
+      "sx/adapter-html.sx", "sx/adapter-sx.sx", "sx/adapter-dom.sx",
+      "sx/boot-helpers.sx", "sx/hypersx.sx", "sx/harness.sx",
+      "sx/harness-reactive.sx", "sx/harness-web.sx",
+      "sx/engine.sx", "sx/orchestration.sx", "sx/boot.sx",
+    ];
+    if (K.beginModuleLoad) K.beginModuleLoad();
+    for (var i = 0; i < files.length; i++) {
+      if (!loadBytecodeFile(files[i])) loadSxFile(files[i]);
+    }
+    if (K.endModuleLoad) K.endModuleLoad();
+    console.log("[sx-platform] Loaded " + files.length + " files (fallback)");
+  }
+
+  /**
+   * Load an optional library on demand (e.g., highlight, harness).
+   * Can be called after boot for pages that need extra modules.
+   */
+  globalThis.__sxLoadLibrary = function(name) {
+    if (!_manifest) loadManifest();
+    if (!_manifest) return false;
+    if (_loadedLibs[name]) return true;
+    if (K.beginModuleLoad) K.beginModuleLoad();
+    var ok = loadLibrary(name, {});
+    if (K.endModuleLoad) K.endModuleLoad();
+    return ok;
+  };
+
+  // ================================================================
+  // Transparent lazy loading — symbol → library index
+  //
+  // When the VM hits an undefined symbol, the resolve hook checks this
+  // index, loads the library that exports it, and returns the value.
+  // The programmer just calls the function — loading is invisible.
+  // ================================================================
+
+  var _symbolIndex = null;  // symbol name → library key
+
+  function buildSymbolIndex() {
+    if (_symbolIndex) return _symbolIndex;
+    if (!_manifest) loadManifest();
+    if (!_manifest) return null;
+    _symbolIndex = {};
+    for (var key in _manifest) {
+      if (key.startsWith('_')) continue;
+      var entry = _manifest[key];
+      if (entry.exports) {
+        for (var i = 0; i < entry.exports.length; i++) {
+          _symbolIndex[entry.exports[i]] = key;
+        }
+      }
+    }
+    return _symbolIndex;
+  }
+
+  // Register the resolve hook — called by the VM when GLOBAL_GET fails
+  K.registerNative("__resolve-symbol", function(args) {
+    var name = args[0];
+    if (!name) return null;
+    var idx = buildSymbolIndex();
+    if (!idx || !idx[name]) return null;
+    var lib = idx[name];
+    if (_loadedLibs[lib]) return null;  // already loaded but symbol still missing — real error
+    // Load the library
+    __sxLoadLibrary(lib);
+    // Return null — the VM will re-lookup in globals after the hook loads the module
+    return null;
+  });
+
+  // ================================================================
+  // Compatibility shim — expose Sx global matching current JS API
+  // ================================================================
+
+  globalThis.Sx = {
+    VERSION: "wasm-1.0",
+    parse: function(src) { return K.parse(src); },
+    eval: function(src) { return K.eval(src); },
+    load: function(src) { return K.load(src); },
+    renderToHtml: function(expr) { return K.renderToHtml(expr); },
+    callFn: function(fn, args) { return K.callFn(fn, args); },
+    engine: function() { return K.engine(); },
+    // Boot entry point (called by auto-init or manually)
+    init: function() {
+      if (typeof K.eval === "function") {
+        // Check boot-init exists
+        // Step through boot manually
+        console.log("[sx] init-css-tracking...");
+        K.eval("(init-css-tracking)");
+        console.log("[sx] process-page-scripts...");
+        K.eval("(process-page-scripts)");
+        console.log("[sx] routes after pages:", K.eval("(len _page-routes)"));
+        console.log("[sx] process-sx-scripts...");
+        K.eval("(process-sx-scripts nil)");
+        console.log("[sx] sx-hydrate-elements...");
+        K.eval("(sx-hydrate-elements nil)");
+        console.log("[sx] sx-hydrate-islands...");
+        K.eval("(sx-hydrate-islands nil)");
+        console.log("[sx] process-elements...");
+        K.eval("(process-elements nil)");
+        // Debug islands
+        console.log("[sx] ~home/stepper defined?", K.eval("(type-of ~home/stepper)"));
+        console.log("[sx] ~layouts/header defined?", K.eval("(type-of ~layouts/header)"));
+        // Island count (JS-side, avoids VM overhead)
+        console.log("[sx] manual island query:", document.querySelectorAll("[data-sx-island]").length);
+        // Try hydrating again
+        console.log("[sx] retry hydrate-islands...");
+        K.eval("(sx-hydrate-islands nil)");
+        // Check if links are boosted
+        var links = document.querySelectorAll("a[href]");
+        var boosted = 0;
+        for (var i = 0; i < links.length; i++) {
+          if (links[i]._sxBoundboost) boosted++;
+        }
+        console.log("[sx] boosted links:", boosted, "/", links.length);
+        // Check island state
+        var islands = document.querySelectorAll("[data-sx-island]");
+        console.log("[sx] islands:", islands.length);
+        for (var j = 0; j < islands.length; j++) {
+          console.log("[sx]   island:", islands[j].getAttribute("data-sx-island"),
+            "hydrated:", !!islands[j]._sxBoundislandhydrated || !!islands[j]["_sxBound" + "island-hydrated"],
+            "children:", islands[j].children.length);
+        }
+        // Register popstate handler for back/forward navigation
+        window.addEventListener("popstate", function(e) {
+          var state = e.state;
+          var scrollY = (state && state.scrollY) ? state.scrollY : 0;
+          K.eval("(handle-popstate " + scrollY + ")");
+        });
+        // Define resolveSuspense now that boot is complete and web stack is loaded.
+        // Must happen AFTER boot — resolve-suspense needs dom-query, render-to-dom etc.
+        Sx.resolveSuspense = function(id, sx) {
+          try {
+            K.eval('(resolve-suspense ' + JSON.stringify(id) + ' ' + JSON.stringify(sx) + ')');
+          } catch (e) {
+            console.error("[sx] resolveSuspense error for id=" + id, e);
+          }
+        };
+        // Process any streaming suspense resolutions that arrived before boot
+        if (globalThis.__sxPending && globalThis.__sxPending.length > 0) {
+          for (var pi = 0; pi < globalThis.__sxPending.length; pi++) {
+            try {
+              Sx.resolveSuspense(globalThis.__sxPending[pi].id, globalThis.__sxPending[pi].sx);
+            } catch(e) { console.error("[sx] pending resolve error:", e); }
+          }
+          globalThis.__sxPending = null;
+        }
+        // Set up direct resolution for future streaming chunks
+        globalThis.__sxResolve = function(id, sx) { Sx.resolveSuspense(id, sx); };
+        // Signal boot complete
+        document.documentElement.setAttribute("data-sx-ready", "true");
+        console.log("[sx] boot done");
+      }
+    }
+  };
+
+  // ================================================================
+  // Auto-init: load web stack and boot on DOMContentLoaded
+  // ================================================================
+
+  if (typeof document !== "undefined") {
+    var _doInit = function() {
+      loadWebStack();
+      Sx.init();
+      // Enable JIT after all boot code has run.
+      // Lazy-load the compiler first — JIT needs it to compile functions.
+      setTimeout(function() {
+        if (K.beginModuleLoad) K.beginModuleLoad();
+        loadLibrary("sx compiler", {});
+        if (K.endModuleLoad) K.endModuleLoad();
+        K.eval('(enable-jit!)');
+      }, 0);
+    };
+
+    if (document.readyState === "loading") {
+      document.addEventListener("DOMContentLoaded", _doInit);
+    } else {
+      _doInit();
+    }
+  }
+
+  } // end boot
+
+  // SxKernel is available synchronously (js_of_ocaml) or after async
+  // WASM init. Poll briefly to handle both cases.
+  var K = globalThis.SxKernel;
+  if (K) { boot(K); return; }
+  var tries = 0;
+  var poll = setInterval(function() {
+    K = globalThis.SxKernel;
+    if (K) { clearInterval(poll); boot(K); }
+    else if (++tries > 100) { clearInterval(poll); console.error("[sx-platform] SxKernel not found after 5s"); }
+  }, 50);
+})();

hosts/ocaml/sx_vm_ref.ml

@@ -287,7 +287,7 @@ let vm_create_closure vm_val frame_val code_val =
 
 (* --- JIT sentinel --- *)
 let _jit_failed_sentinel = {
-  vm_code = { vc_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
+  vm_code = { vc_arity = -1; vc_rest_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
               vc_bytecode_list = None; vc_constants_list = None };
   vm_upvalues = [||]; vm_name = Some "__jit_failed__"; vm_env_ref = Hashtbl.create 0; vm_closure_env = None
 }

hosts/ocaml/transpiler.sx

@@ -269,7 +269,8 @@
     "try-catch"
     "set-render-active!"
     "scope-emitted"
-    "jit-try-call"))
+    "jit-try-call"
+    "jit-skip?"))
 
 (define
   ml-is-known-name?

lib/compiler.sx

@@ -589,6 +589,43 @@
                   (list (list (make-symbol loop-name) lambda-expr)))
                 (call-expr (cons (make-symbol loop-name) inits)))
               (compile-letrec em (list letrec-bindings call-expr) scope tail?)))
+          (if
+            (dict? (first args))
+            (let
+              ((pattern (first args))
+                (source-expr (nth args 1))
+                (body (slice args 2))
+                (let-scope (make-scope scope)))
+              (dict-set! let-scope "next-slot" (get scope "next-slot"))
+              (compile-expr em source-expr let-scope false)
+              (let
+                ((temp-slot (scope-define-local let-scope "__dict_src")))
+                (emit-op em 17)
+                (emit-byte em temp-slot)
+                (for-each
+                  (fn
+                    (k)
+                    (let
+                      ((var-name (get pattern k))
+                        (key-str
+                          (if
+                            (= (type-of k) "keyword")
+                            (keyword-name k)
+                            (str k))))
+                      (emit-op em 16)
+                      (emit-byte em temp-slot)
+                      (emit-const em key-str)
+                      (let
+                        ((get-idx (pool-add (get em "pool") "get")))
+                        (emit-op em 52)
+                        (emit-u16 em get-idx)
+                        (emit-byte em 2))
+                      (let
+                        ((slot (scope-define-local let-scope (if (= (type-of var-name) "symbol") (symbol-name var-name) var-name))))
+                        (emit-op em 17)
+                        (emit-byte em slot))))
+                  (keys pattern))
+                (compile-begin em body let-scope tail?)))
             (let
               ((bindings (first args))
                 (body (rest args))
@@ -598,14 +635,15 @@
                 (fn
                   (binding)
                   (let
-                  ((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding)))
-                    (value (nth binding 1))
-                    (slot (scope-define-local let-scope name)))
+                    ((name (if (= (type-of (first binding)) "symbol") (first binding) (make-symbol (first binding))))
+                      (value (nth binding 1)))
                     (compile-expr em value let-scope false)
+                    (let
+                      ((slot (scope-define-local let-scope (symbol-name name))))
                       (emit-op em 17)
-                  (emit-byte em slot)))
+                      (emit-byte em slot))))
                 bindings)
-            (compile-begin em body let-scope tail?)))))
+              (compile-begin em body let-scope tail?))))))
     (define
       compile-letrec
       (fn
@@ -640,20 +678,29 @@
             (fn-scope (make-scope scope))
             (fn-em (make-emitter)))
           (dict-set! fn-scope "is-function" true)
+          (let
+            ((rest-pos -1) (rest-name nil))
             (for-each
               (fn
                 (p)
                 (let
                   ((name (cond (= (type-of p) "symbol") (symbol-name p) (and (list? p) (not (empty? p)) (= (type-of (first p)) "symbol")) (symbol-name (first p)) :else p)))
+                  (cond
+                    (= name "&rest")
+                    (set! rest-pos (len (get fn-scope "locals")))
+                    (= name "&key")
+                    nil
+                    :else (do
                       (when
-                  (and (not (= name "&key")) (not (= name "&rest")))
-                  (scope-define-local fn-scope name))))
+                        (and (> rest-pos -1) (nil? rest-name))
+                        (set! rest-name name))
+                      (scope-define-local fn-scope name)))))
               params)
             (compile-begin fn-em body fn-scope true)
             (emit-op fn-em 50)
             (let
               ((upvals (get fn-scope "upvalues"))
-              (code {:upvalue-count (len upvals) :arity (len (get fn-scope "locals")) :constants (get (get fn-em "pool") "entries") :bytecode (get fn-em "bytecode")})
+                (code (if (> rest-pos -1) {:upvalue-count (len upvals) :arity (len (get fn-scope "locals")) :constants (get (get fn-em "pool") "entries") :rest-arity rest-pos :bytecode (get fn-em "bytecode")} {:upvalue-count (len upvals) :arity (len (get fn-scope "locals")) :constants (get (get fn-em "pool") "entries") :bytecode (get fn-em "bytecode")}))
                 (code-idx (pool-add (get em "pool") code)))
               (emit-op em 51)
               (emit-u16 em code-idx)
@@ -662,7 +709,7 @@
                   (uv)
                   (emit-byte em (if (get uv "is-local") 1 0))
                   (emit-byte em (get uv "index")))
-              upvals)))))
+                upvals))))))
     (define
       compile-define
       (fn
@@ -681,7 +728,7 @@
                   (and
                     (not (empty? rest-args))
                     (= (type-of (first rest-args)) "keyword"))
-                  (let
+                  (letrec
                     ((skip-annotations (fn (items) (if (empty? items) nil (if (= (type-of (first items)) "keyword") (skip-annotations (rest (rest items))) (first items))))))
                     (skip-annotations rest-args))
                   (first rest-args)))))

lib/erlang/parser-core.sx

@@ -0,0 +1,49 @@
+;; Core parser helpers — shared by er-parse-expr and er-parse-module.
+;; Everything reads/mutates a parser state dict:
+;;   {:toks TOKS :idx INDEX}
+
+(define er-state-make (fn (toks) {:idx 0 :toks toks}))
+
+(define
+  er-peek
+  (fn
+    (st offset)
+    (let
+      ((toks (get st :toks)) (idx (+ (get st :idx) offset)))
+      (if (< idx (len toks)) (nth toks idx) (nth toks (- (len toks) 1))))))
+
+(define er-cur (fn (st) (er-peek st 0)))
+
+(define er-cur-type (fn (st) (get (er-cur st) :type)))
+(define er-cur-value (fn (st) (get (er-cur st) :value)))
+
+(define er-advance! (fn (st) (dict-set! st :idx (+ (get st :idx) 1))))
+
+(define er-at-eof? (fn (st) (= (er-cur-type st) "eof")))
+
+(define
+  er-is?
+  (fn
+    (st type value)
+    (and
+      (= (er-cur-type st) type)
+      (or (= value nil) (= (er-cur-value st) value)))))
+
+(define
+  er-expect!
+  (fn
+    (st type value)
+    (if
+      (er-is? st type value)
+      (let ((t (er-cur st))) (er-advance! st) t)
+      (error
+        (str
+          "Erlang parse: expected "
+          type
+          (if value (str " '" value "'") "")
+          " but got "
+          (er-cur-type st)
+          " '"
+          (er-cur-value st)
+          "' at pos "
+          (get (er-cur st) :pos))))))

lib/erlang/parser-expr.sx

@@ -0,0 +1,534 @@
+;; Erlang expression parser — top-level fns operating on parser state.
+;; Depends on parser-core.sx (er-state-*, er-cur-*, er-is?, er-expect!)
+;; and parser.sx (er-is-binop?, er-any-binop?, er-build-cons, er-slice-list).
+
+;; ── entry point ───────────────────────────────────────────────────
+(define
+  er-parse-expr
+  (fn
+    (src)
+    (let
+      ((st (er-state-make (er-tokenize src))))
+      (er-parse-expr-prec st 0))))
+
+;; Pratt-like operator-precedence parser.
+(define
+  er-parse-expr-prec
+  (fn
+    (st min-prec)
+    (let
+      ((left (er-parse-unary st)))
+      (er-parse-expr-loop st min-prec left))))
+
+(define
+  er-parse-expr-loop
+  (fn
+    (st min-prec left)
+    (if
+      (er-any-binop? (er-cur st) min-prec)
+      (let
+        ((tok (er-cur st)))
+        (cond
+          (er-is-binop? tok 0)
+          (do (er-advance! st) (er-parse-expr-loop st min-prec {:rhs (er-parse-expr-prec st 0) :type "match" :lhs left}))
+          (er-is-binop? tok 1)
+          (do (er-advance! st) (er-parse-expr-loop st min-prec {:msg (er-parse-expr-prec st 1) :type "send" :to left}))
+          (er-is-binop? tok 2)
+          (let
+            ((op (get tok :value)))
+            (er-advance! st)
+            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 3)) :type "op" :op op}))
+          (er-is-binop? tok 3)
+          (let
+            ((op (get tok :value)))
+            (er-advance! st)
+            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 4)) :type "op" :op op}))
+          (er-is-binop? tok 4)
+          (let
+            ((op (get tok :value)))
+            (er-advance! st)
+            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 5)) :type "op" :op op}))
+          (er-is-binop? tok 5)
+          (let
+            ((op (get tok :value)))
+            (er-advance! st)
+            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 5)) :type "op" :op op}))
+          (er-is-binop? tok 6)
+          (let
+            ((op (get tok :value)))
+            (er-advance! st)
+            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 7)) :type "op" :op op}))
+          (er-is-binop? tok 7)
+          (let
+            ((op (get tok :value)))
+            (er-advance! st)
+            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 8)) :type "op" :op op}))
+          :else left))
+      left)))
+
+(define
+  er-parse-unary
+  (fn
+    (st)
+    (cond
+      (er-is? st "op" "-")
+      (do (er-advance! st) {:arg (er-parse-unary st) :type "unop" :op "-"})
+      (er-is? st "op" "+")
+      (do (er-advance! st) (er-parse-unary st))
+      (er-is? st "keyword" "not")
+      (do (er-advance! st) {:arg (er-parse-unary st) :type "unop" :op "not"})
+      (er-is? st "keyword" "bnot")
+      (do (er-advance! st) {:arg (er-parse-unary st) :type "unop" :op "bnot"})
+      :else (er-parse-postfix st))))
+
+(define
+  er-parse-postfix
+  (fn (st) (er-parse-postfix-loop st (er-parse-primary st))))
+
+(define
+  er-parse-postfix-loop
+  (fn
+    (st node)
+    (cond
+      (er-is? st "punct" ":")
+      (do
+        (er-advance! st)
+        (let
+          ((rhs (er-parse-primary st)))
+          (er-parse-postfix-loop st {:fun rhs :mod node :type "remote"})))
+      (er-is? st "punct" "(")
+      (let
+        ((args (er-parse-call-args st)))
+        (er-parse-postfix-loop st {:args args :fun node :type "call"}))
+      :else node)))
+
+(define
+  er-parse-call-args
+  (fn
+    (st)
+    (er-expect! st "punct" "(")
+    (if
+      (er-is? st "punct" ")")
+      (do (er-advance! st) (list))
+      (let
+        ((args (list (er-parse-expr-prec st 0))))
+        (er-parse-args-tail st args)))))
+
+(define
+  er-parse-args-tail
+  (fn
+    (st args)
+    (cond
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! args (er-parse-expr-prec st 0))
+        (er-parse-args-tail st args))
+      (er-is? st "punct" ")")
+      (do (er-advance! st) args)
+      :else (error
+        (str
+          "Erlang parse: expected ',' or ')' in args, got '"
+          (er-cur-value st)
+          "'")))))
+
+;; A body is: Expr {, Expr}
+(define
+  er-parse-body
+  (fn
+    (st)
+    (let
+      ((exprs (list (er-parse-expr-prec st 0))))
+      (er-parse-body-tail st exprs))))
+
+(define
+  er-parse-body-tail
+  (fn
+    (st exprs)
+    (if
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! exprs (er-parse-expr-prec st 0))
+        (er-parse-body-tail st exprs))
+      exprs)))
+
+;; Guards: G1 ; G2 ; ... where each Gi is a guard-conj (T, T, ...)
+(define
+  er-parse-guards
+  (fn
+    (st)
+    (let
+      ((alts (list (er-parse-guard-conj st))))
+      (er-parse-guards-tail st alts))))
+
+(define
+  er-parse-guards-tail
+  (fn
+    (st alts)
+    (if
+      (er-is? st "punct" ";")
+      (do
+        (er-advance! st)
+        (append! alts (er-parse-guard-conj st))
+        (er-parse-guards-tail st alts))
+      alts)))
+
+(define
+  er-parse-guard-conj
+  (fn
+    (st)
+    (let
+      ((ts (list (er-parse-expr-prec st 0))))
+      (er-parse-guard-conj-tail st ts))))
+
+(define
+  er-parse-guard-conj-tail
+  (fn
+    (st ts)
+    (if
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! ts (er-parse-expr-prec st 0))
+        (er-parse-guard-conj-tail st ts))
+      ts)))
+
+(define er-parse-pattern (fn (st) (er-parse-expr-prec st 0)))
+
+;; ── primary expressions ──────────────────────────────────────────
+(define
+  er-parse-primary
+  (fn
+    (st)
+    (let
+      ((tok (er-cur st)))
+      (cond
+        (= (er-cur-type st) "integer")
+        (do (er-advance! st) {:value (get tok :value) :type "integer"})
+        (= (er-cur-type st) "float")
+        (do (er-advance! st) {:value (get tok :value) :type "float"})
+        (= (er-cur-type st) "string")
+        (do (er-advance! st) {:value (get tok :value) :type "string"})
+        (= (er-cur-type st) "atom")
+        (do (er-advance! st) {:value (get tok :value) :type "atom"})
+        (= (er-cur-type st) "var")
+        (do (er-advance! st) {:type "var" :name (get tok :value)})
+        (er-is? st "punct" "(")
+        (do
+          (er-advance! st)
+          (let
+            ((e (er-parse-expr-prec st 0)))
+            (er-expect! st "punct" ")")
+            e))
+        (er-is? st "punct" "{")
+        (er-parse-tuple st)
+        (er-is? st "punct" "[")
+        (er-parse-list st)
+        (er-is? st "keyword" "if")
+        (er-parse-if st)
+        (er-is? st "keyword" "case")
+        (er-parse-case st)
+        (er-is? st "keyword" "receive")
+        (er-parse-receive st)
+        (er-is? st "keyword" "begin")
+        (er-parse-begin st)
+        (er-is? st "keyword" "fun")
+        (er-parse-fun-expr st)
+        (er-is? st "keyword" "try")
+        (er-parse-try st)
+        :else (error
+          (str
+            "Erlang parse: unexpected "
+            (er-cur-type st)
+            " '"
+            (get tok :value)
+            "' at pos "
+            (get tok :pos)))))))
+
+(define
+  er-parse-tuple
+  (fn
+    (st)
+    (er-expect! st "punct" "{")
+    (if
+      (er-is? st "punct" "}")
+      (do (er-advance! st) {:elements (list) :type "tuple"})
+      (let
+        ((elems (list (er-parse-expr-prec st 0))))
+        (er-parse-tuple-tail st elems)))))
+
+(define
+  er-parse-tuple-tail
+  (fn
+    (st elems)
+    (cond
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! elems (er-parse-expr-prec st 0))
+        (er-parse-tuple-tail st elems))
+      (er-is? st "punct" "}")
+      (do (er-advance! st) {:elements elems :type "tuple"})
+      :else (error
+        (str
+          "Erlang parse: expected ',' or '}' in tuple, got '"
+          (er-cur-value st)
+          "'")))))
+
+(define
+  er-parse-list
+  (fn
+    (st)
+    (er-expect! st "punct" "[")
+    (if
+      (er-is? st "punct" "]")
+      (do (er-advance! st) {:type "nil"})
+      (let
+        ((elems (list (er-parse-expr-prec st 0))))
+        (er-parse-list-tail st elems)))))
+
+(define
+  er-parse-list-tail
+  (fn
+    (st elems)
+    (cond
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! elems (er-parse-expr-prec st 0))
+        (er-parse-list-tail st elems))
+      (er-is? st "punct" "|")
+      (do
+        (er-advance! st)
+        (let
+          ((tail (er-parse-expr-prec st 0)))
+          (er-expect! st "punct" "]")
+          (er-build-cons elems tail)))
+      (er-is? st "punct" "]")
+      (do (er-advance! st) (er-build-cons elems {:type "nil"}))
+      :else (error
+        (str
+          "Erlang parse: expected ',' '|' or ']' in list, got '"
+          (er-cur-value st)
+          "'")))))
+
+;; ── if ──────────────────────────────────────────────────────────
+(define
+  er-parse-if
+  (fn
+    (st)
+    (er-expect! st "keyword" "if")
+    (let
+      ((clauses (list (er-parse-if-clause st))))
+      (er-parse-if-tail st clauses))))
+
+(define
+  er-parse-if-tail
+  (fn
+    (st clauses)
+    (if
+      (er-is? st "punct" ";")
+      (do
+        (er-advance! st)
+        (append! clauses (er-parse-if-clause st))
+        (er-parse-if-tail st clauses))
+      (do (er-expect! st "keyword" "end") {:clauses clauses :type "if"}))))
+
+(define
+  er-parse-if-clause
+  (fn
+    (st)
+    (let
+      ((guards (er-parse-guards st)))
+      (er-expect! st "punct" "->")
+      (let ((body (er-parse-body st))) {:body body :guards guards}))))
+
+;; ── case ────────────────────────────────────────────────────────
+(define
+  er-parse-case
+  (fn
+    (st)
+    (er-expect! st "keyword" "case")
+    (let
+      ((e (er-parse-expr-prec st 0)))
+      (er-expect! st "keyword" "of")
+      (let
+        ((clauses (list (er-parse-case-clause st))))
+        (er-parse-case-tail st e clauses)))))
+
+(define
+  er-parse-case-tail
+  (fn
+    (st e clauses)
+    (if
+      (er-is? st "punct" ";")
+      (do
+        (er-advance! st)
+        (append! clauses (er-parse-case-clause st))
+        (er-parse-case-tail st e clauses))
+      (do (er-expect! st "keyword" "end") {:expr e :clauses clauses :type "case"}))))
+
+(define
+  er-parse-case-clause
+  (fn
+    (st)
+    (let
+      ((pat (er-parse-pattern st)))
+      (let
+        ((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
+        (er-expect! st "punct" "->")
+        (let ((body (er-parse-body st))) {:pattern pat :body body :guards guards})))))
+
+;; ── receive ─────────────────────────────────────────────────────
+(define
+  er-parse-receive
+  (fn
+    (st)
+    (er-expect! st "keyword" "receive")
+    (let
+      ((clauses (if (er-is? st "keyword" "after") (list) (list (er-parse-case-clause st)))))
+      (er-parse-receive-clauses st clauses))))
+
+(define
+  er-parse-receive-clauses
+  (fn
+    (st clauses)
+    (cond
+      (er-is? st "punct" ";")
+      (do
+        (er-advance! st)
+        (append! clauses (er-parse-case-clause st))
+        (er-parse-receive-clauses st clauses))
+      (er-is? st "keyword" "after")
+      (do
+        (er-advance! st)
+        (let
+          ((after-ms (er-parse-expr-prec st 0)))
+          (er-expect! st "punct" "->")
+          (let
+            ((after-body (er-parse-body st)))
+            (er-expect! st "keyword" "end")
+            {:clauses clauses :type "receive" :after-ms after-ms :after-body after-body})))
+      :else (do (er-expect! st "keyword" "end") {:clauses clauses :type "receive" :after-ms nil :after-body (list)}))))
+
+(define
+  er-parse-begin
+  (fn
+    (st)
+    (er-expect! st "keyword" "begin")
+    (let
+      ((exprs (er-parse-body st)))
+      (er-expect! st "keyword" "end")
+      {:exprs exprs :type "block"})))
+
+(define
+  er-parse-fun-expr
+  (fn
+    (st)
+    (er-expect! st "keyword" "fun")
+    (cond
+      (er-is? st "punct" "(")
+      (let
+        ((clauses (list (er-parse-fun-clause st nil))))
+        (er-parse-fun-expr-tail st clauses))
+      :else (error "Erlang parse: fun-ref syntax not yet supported"))))
+
+(define
+  er-parse-fun-expr-tail
+  (fn
+    (st clauses)
+    (if
+      (er-is? st "punct" ";")
+      (do
+        (er-advance! st)
+        (append! clauses (er-parse-fun-clause st nil))
+        (er-parse-fun-expr-tail st clauses))
+      (do (er-expect! st "keyword" "end") {:clauses clauses :type "fun"}))))
+
+(define
+  er-parse-fun-clause
+  (fn
+    (st named-name)
+    (er-expect! st "punct" "(")
+    (let
+      ((patterns (if (er-is? st "punct" ")") (list) (er-parse-pattern-list st (list (er-parse-pattern st))))))
+      (er-expect! st "punct" ")")
+      (let
+        ((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
+        (er-expect! st "punct" "->")
+        (let ((body (er-parse-body st))) {:patterns patterns :body body :guards guards :name named-name})))))
+
+(define
+  er-parse-pattern-list
+  (fn
+    (st pats)
+    (if
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! pats (er-parse-pattern st))
+        (er-parse-pattern-list st pats))
+      pats)))
+
+;; ── try ─────────────────────────────────────────────────────────
+(define
+  er-parse-try
+  (fn
+    (st)
+    (er-expect! st "keyword" "try")
+    (let
+      ((exprs (er-parse-body st))
+        (of-clauses (list))
+        (catch-clauses (list))
+        (after-body (list)))
+      (when
+        (er-is? st "keyword" "of")
+        (er-advance! st)
+        (append! of-clauses (er-parse-case-clause st))
+        (er-parse-try-of-tail st of-clauses))
+      (when
+        (er-is? st "keyword" "catch")
+        (er-advance! st)
+        (append! catch-clauses (er-parse-catch-clause st))
+        (er-parse-try-catch-tail st catch-clauses))
+      (when
+        (er-is? st "keyword" "after")
+        (er-advance! st)
+        (set! after-body (er-parse-body st)))
+      (er-expect! st "keyword" "end")
+      {:exprs exprs :catch-clauses catch-clauses :type "try" :of-clauses of-clauses :after after-body})))
+
+(define
+  er-parse-try-of-tail
+  (fn
+    (st clauses)
+    (when
+      (er-is? st "punct" ";")
+      (er-advance! st)
+      (append! clauses (er-parse-case-clause st))
+      (er-parse-try-of-tail st clauses))))
+
+(define
+  er-parse-try-catch-tail
+  (fn
+    (st clauses)
+    (when
+      (er-is? st "punct" ";")
+      (er-advance! st)
+      (append! clauses (er-parse-catch-clause st))
+      (er-parse-try-catch-tail st clauses))))
+
+(define
+  er-parse-catch-clause
+  (fn
+    (st)
+    (let
+      ((p1 (er-parse-pattern st)))
+      (let
+        ((klass (if (= (get p1 :type) "remote") (get p1 :mod) {:value "throw" :type "atom"}))
+          (pat (if (= (get p1 :type) "remote") (get p1 :fun) p1)))
+        (let
+          ((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
+          (er-expect! st "punct" "->")
+          (let ((body (er-parse-body st))) {:pattern pat :body body :class klass :guards guards}))))))

lib/erlang/parser-module.sx

@@ -0,0 +1,113 @@
+;; Erlang module parser — reads top-level forms and builds a module AST.
+;;
+;; Depends on parser-core.sx, parser.sx, parser-expr.sx.
+
+(define
+  er-parse-module
+  (fn
+    (src)
+    (let
+      ((st (er-state-make (er-tokenize src)))
+        (mod-ref (list nil))
+        (attrs (list))
+        (functions (list)))
+      (er-parse-module-loop st mod-ref attrs functions)
+      {:functions functions :type "module" :attrs attrs :name (nth mod-ref 0)})))
+
+(define
+  er-parse-module-loop
+  (fn
+    (st mod-ref attrs functions)
+    (when
+      (not (er-at-eof? st))
+      (er-parse-top-form st mod-ref attrs functions)
+      (er-parse-module-loop st mod-ref attrs functions))))
+
+(define
+  er-parse-top-form
+  (fn
+    (st mod-ref attrs functions)
+    (cond
+      (er-is? st "op" "-")
+      (do
+        (er-advance! st)
+        (let
+          ((attr-name (er-cur-value st)))
+          (er-advance! st)
+          (let
+            ((args (er-parse-attr-args st)))
+            (er-expect! st "punct" ".")
+            (cond
+              (= attr-name "module")
+              (set-nth! mod-ref 0 (get (nth args 0) :value))
+              :else (append! attrs {:args args :name attr-name})))))
+      (= (er-cur-type st) "atom")
+      (append! functions (er-parse-function st))
+      :else (error
+        (str
+          "Erlang parse (top): unexpected "
+          (er-cur-type st)
+          " '"
+          (er-cur-value st)
+          "' at pos "
+          (get (er-cur st) :pos))))))
+
+(define
+  er-parse-attr-args
+  (fn
+    (st)
+    (er-expect! st "punct" "(")
+    (if
+      (er-is? st "punct" ")")
+      (do (er-advance! st) (list))
+      (let
+        ((args (list (er-parse-attr-arg st))))
+        (er-parse-attr-args-tail st args)))))
+
+(define
+  er-parse-attr-args-tail
+  (fn
+    (st args)
+    (cond
+      (er-is? st "punct" ",")
+      (do
+        (er-advance! st)
+        (append! args (er-parse-attr-arg st))
+        (er-parse-attr-args-tail st args))
+      (er-is? st "punct" ")")
+      (do (er-advance! st) args)
+      :else (error (str "Erlang parse attr: got '" (er-cur-value st) "'")))))
+
+;; Attribute args often contain `Name/Arity` pairs — parse as a
+;; general expression so the caller can interpret the shape.
+(define er-parse-attr-arg (fn (st) (er-parse-expr-prec st 0)))
+
+(define
+  er-parse-function
+  (fn
+    (st)
+    (let
+      ((name (er-cur-value st)))
+      (er-advance! st)
+      (let
+        ((clauses (list (er-parse-fun-clause st name))))
+        (er-parse-function-tail st name clauses)
+        (er-expect! st "punct" ".")
+        (let ((arity (len (get (nth clauses 0) :patterns)))) {:arity arity :clauses clauses :type "function" :name name})))))
+
+(define
+  er-parse-function-tail
+  (fn
+    (st name clauses)
+    (when
+      (er-is? st "punct" ";")
+      (let
+        ((save (get st :idx)))
+        (er-advance! st)
+        (if
+          (and (= (er-cur-type st) "atom") (= (er-cur-value st) name))
+          (do
+            (er-advance! st)
+            (append! clauses (er-parse-fun-clause st name))
+            (er-parse-function-tail st name clauses))
+          (dict-set! st :idx save))))))

lib/erlang/parser.sx

@@ -0,0 +1,111 @@
+;; Erlang parser — turns a token list into an AST.
+;;
+;; Shared state lives in the surrounding `let` of `er-parse-*`.
+;; All helpers use recursion (no `while` in SX).
+;;
+;; AST node shapes:
+;;   {:type "atom"      :value "foo"}
+;;   {:type "integer"   :value "42"}                  ; value kept as string
+;;   {:type "float"     :value "3.14"}
+;;   {:type "string"    :value "hi"}
+;;   {:type "var"       :name "X"}                    ; "_" is wildcard
+;;   {:type "nil"}
+;;   {:type "tuple"     :elements [...]}
+;;   {:type "cons"      :head E :tail E}
+;;   {:type "call"      :fun E :args [...]}
+;;   {:type "remote"    :mod E :fun E}
+;;   {:type "op"        :op OP :args [L R]}
+;;   {:type "unop"      :op OP :arg E}
+;;   {:type "match"     :lhs P :rhs E}
+;;   {:type "send"      :to E :msg E}
+;;   {:type "if"        :clauses [{:guards [...] :body [...]} ...]}
+;;   {:type "case"      :expr E :clauses [{:pattern P :guards [...] :body [...]} ...]}
+;;   {:type "receive"   :clauses [...] :after-ms E-or-nil :after-body [...]}
+;;   {:type "fun"       :clauses [...]}
+;;   {:type "block"     :exprs [...]}
+;;   {:type "try"       :exprs [...] :of-clauses [...] :catch-clauses [...] :after [...]}
+;;   Top-level: {:type "module" :name A :attrs [{:name A :args [...]} ...] :functions [...]}
+;;              {:type "function" :name A :arity N :clauses [{:name :patterns :guards :body}]}
+
+(define
+  er-is-binop?
+  (fn
+    (tok prec)
+    (let
+      ((ty (get tok :type)) (v (get tok :value)))
+      (cond
+        (= prec 0)
+        (and (= ty "op") (= v "="))
+        (= prec 1)
+        (and (= ty "op") (= v "!"))
+        (= prec 2)
+        (or
+          (and (= ty "keyword") (= v "orelse"))
+          (and (= ty "keyword") (= v "or"))
+          (and (= ty "keyword") (= v "xor")))
+        (= prec 3)
+        (or
+          (and (= ty "keyword") (= v "andalso"))
+          (and (= ty "keyword") (= v "and")))
+        (= prec 4)
+        (and
+          (= ty "op")
+          (or
+            (= v "==")
+            (= v "/=")
+            (= v "=:=")
+            (= v "=/=")
+            (= v "<")
+            (= v ">")
+            (= v "=<")
+            (= v ">=")))
+        (= prec 5)
+        (and (= ty "op") (or (= v "++") (= v "--")))
+        (= prec 6)
+        (and (= ty "op") (or (= v "+") (= v "-")))
+        (= prec 7)
+        (or
+          (and (= ty "op") (or (= v "*") (= v "/")))
+          (and
+            (= ty "keyword")
+            (or
+              (= v "div")
+              (= v "rem")
+              (= v "band")
+              (= v "bor")
+              (= v "bxor")
+              (= v "bsl")
+              (= v "bsr"))))
+        :else false))))
+
+(define
+  er-any-binop?
+  (fn
+    (tok min-prec)
+    (or
+      (and (>= 0 min-prec) (er-is-binop? tok 0))
+      (and (>= 1 min-prec) (er-is-binop? tok 1))
+      (and (>= 2 min-prec) (er-is-binop? tok 2))
+      (and (>= 3 min-prec) (er-is-binop? tok 3))
+      (and (>= 4 min-prec) (er-is-binop? tok 4))
+      (and (>= 5 min-prec) (er-is-binop? tok 5))
+      (and (>= 6 min-prec) (er-is-binop? tok 6))
+      (and (>= 7 min-prec) (er-is-binop? tok 7)))))
+
+(define
+  er-slice-list
+  (fn
+    (xs from)
+    (if
+      (>= from (len xs))
+      (list)
+      (let
+        ((out (list)))
+        (for-each
+          (fn (i) (append! out (nth xs i)))
+          (range from (len xs)))
+        out))))
+
+(define
+  er-build-cons
+  (fn (elems tail) (if (= (len elems) 0) tail {:head (nth elems 0) :tail (er-build-cons (er-slice-list elems 1) tail) :type "cons"})))

lib/erlang/tests/parse.sx

@@ -0,0 +1,230 @@
+;; Erlang parser tests
+
+(define er-parse-test-count 0)
+(define er-parse-test-pass 0)
+(define er-parse-test-fails (list))
+
+(define
+  deep=
+  (fn
+    (a b)
+    (cond
+      (and (= (type-of a) "dict") (= (type-of b) "dict"))
+      (let
+        ((ka (sort (keys a))) (kb (sort (keys b))))
+        (and (= ka kb) (every? (fn (k) (deep= (get a k) (get b k))) ka)))
+      (and (= (type-of a) "list") (= (type-of b) "list"))
+      (and
+        (= (len a) (len b))
+        (every? (fn (i) (deep= (nth a i) (nth b i))) (range 0 (len a))))
+      :else (= a b))))
+
+(define
+  er-parse-test
+  (fn
+    (name actual expected)
+    (set! er-parse-test-count (+ er-parse-test-count 1))
+    (if
+      (deep= actual expected)
+      (set! er-parse-test-pass (+ er-parse-test-pass 1))
+      (append! er-parse-test-fails {:actual actual :expected expected :name name}))))
+(define pe er-parse-expr)
+
+;; ── literals ──────────────────────────────────────────────────────
+(define pm er-parse-module)
+
+(er-parse-test "int" (pe "42") {:value "42" :type "integer"})
+
+(er-parse-test "float" (pe "3.14") {:value "3.14" :type "float"})
+
+(er-parse-test "atom" (pe "foo") {:value "foo" :type "atom"})
+
+(er-parse-test "quoted atom" (pe "'Hello'") {:value "Hello" :type "atom"})
+
+(er-parse-test "var" (pe "X") {:type "var" :name "X"})
+
+(er-parse-test "wildcard" (pe "_") {:type "var" :name "_"})
+
+(er-parse-test "string" (pe "\"hello\"") {:value "hello" :type "string"})
+
+;; ── tuples ────────────────────────────────────────────────────────
+(er-parse-test "nil list" (pe "[]") {:type "nil"})
+
+(er-parse-test "empty tuple" (pe "{}") {:elements (list) :type "tuple"})
+
+(er-parse-test "pair" (pe "{ok, 1}") {:elements (list {:value "ok" :type "atom"} {:value "1" :type "integer"}) :type "tuple"})
+
+;; ── lists ─────────────────────────────────────────────────────────
+(er-parse-test "triple" (pe "{a, b, c}") {:elements (list {:value "a" :type "atom"} {:value "b" :type "atom"} {:value "c" :type "atom"}) :type "tuple"})
+
+(er-parse-test "list [1]" (pe "[1]") {:head {:value "1" :type "integer"} :tail {:type "nil"} :type "cons"})
+
+(er-parse-test "cons [H|T]" (pe "[H|T]") {:head {:type "var" :name "H"} :tail {:type "var" :name "T"} :type "cons"})
+
+;; ── operators / precedence ────────────────────────────────────────
+(er-parse-test "list [1,2]" (pe "[1,2]") {:head {:value "1" :type "integer"} :tail {:head {:value "2" :type "integer"} :tail {:type "nil"} :type "cons"} :type "cons"})
+
+(er-parse-test "add" (pe "1 + 2") {:args (list {:value "1" :type "integer"} {:value "2" :type "integer"}) :type "op" :op "+"})
+
+(er-parse-test "mul binds tighter" (pe "1 + 2 * 3") {:args (list {:value "1" :type "integer"} {:args (list {:value "2" :type "integer"} {:value "3" :type "integer"}) :type "op" :op "*"}) :type "op" :op "+"})
+
+(er-parse-test "parens" (pe "(1 + 2) * 3") {:args (list {:args (list {:value "1" :type "integer"} {:value "2" :type "integer"}) :type "op" :op "+"} {:value "3" :type "integer"}) :type "op" :op "*"})
+
+(er-parse-test "neg unary" (pe "-5") {:arg {:value "5" :type "integer"} :type "unop" :op "-"})
+
+(er-parse-test "not" (pe "not X") {:arg {:type "var" :name "X"} :type "unop" :op "not"})
+
+(er-parse-test "match" (pe "X = 42") {:rhs {:value "42" :type "integer"} :type "match" :lhs {:type "var" :name "X"}})
+
+(er-parse-test "cmp" (pe "X > 0") {:args (list {:type "var" :name "X"} {:value "0" :type "integer"}) :type "op" :op ">"})
+
+(er-parse-test "eq =:=" (pe "X =:= 1") {:args (list {:type "var" :name "X"} {:value "1" :type "integer"}) :type "op" :op "=:="})
+
+(er-parse-test "send" (pe "Pid ! hello") {:msg {:value "hello" :type "atom"} :type "send" :to {:type "var" :name "Pid"}})
+
+(er-parse-test "andalso" (pe "X andalso Y") {:args (list {:type "var" :name "X"} {:type "var" :name "Y"}) :type "op" :op "andalso"})
+
+(er-parse-test "orelse" (pe "X orelse Y") {:args (list {:type "var" :name "X"} {:type "var" :name "Y"}) :type "op" :op "orelse"})
+
+(er-parse-test "++" (pe "A ++ B") {:args (list {:type "var" :name "A"} {:type "var" :name "B"}) :type "op" :op "++"})
+
+(er-parse-test "div" (pe "10 div 3") {:args (list {:value "10" :type "integer"} {:value "3" :type "integer"}) :type "op" :op "div"})
+
+;; ── calls ─────────────────────────────────────────────────────────
+(er-parse-test "rem" (pe "10 rem 3") {:args (list {:value "10" :type "integer"} {:value "3" :type "integer"}) :type "op" :op "rem"})
+
+(er-parse-test "local call 0-arity" (pe "self()") {:args (list) :fun {:value "self" :type "atom"} :type "call"})
+
+(er-parse-test "local call 2-arg" (pe "foo(1, 2)") {:args (list {:value "1" :type "integer"} {:value "2" :type "integer"}) :fun {:value "foo" :type "atom"} :type "call"})
+
+;; ── if / case / receive / fun / try ───────────────────────────────
+(er-parse-test "remote call" (pe "lists:map(F, L)") {:args (list {:type "var" :name "F"} {:type "var" :name "L"}) :fun {:fun {:value "map" :type "atom"} :mod {:value "lists" :type "atom"} :type "remote"} :type "call"})
+
+(er-parse-test "if-else" (pe "if X > 0 -> pos; true -> neg end") {:clauses (list {:body (list {:value "pos" :type "atom"}) :guards (list (list {:args (list {:type "var" :name "X"} {:value "0" :type "integer"}) :type "op" :op ">"}))} {:body (list {:value "neg" :type "atom"}) :guards (list (list {:value "true" :type "atom"}))}) :type "if"})
+
+(er-parse-test
+  "case 2-clause"
+  (pe "case X of 0 -> zero; _ -> nz end")
+  {:expr {:type "var" :name "X"} :clauses (list {:pattern {:value "0" :type "integer"} :body (list {:value "zero" :type "atom"}) :guards (list)} {:pattern {:type "var" :name "_"} :body (list {:value "nz" :type "atom"}) :guards (list)}) :type "case"})
+
+(er-parse-test
+  "case with guard"
+  (pe "case X of N when N > 0 -> pos; _ -> other end")
+  {:expr {:type "var" :name "X"} :clauses (list {:pattern {:type "var" :name "N"} :body (list {:value "pos" :type "atom"}) :guards (list (list {:args (list {:type "var" :name "N"} {:value "0" :type "integer"}) :type "op" :op ">"}))} {:pattern {:type "var" :name "_"} :body (list {:value "other" :type "atom"}) :guards (list)}) :type "case"})
+
+(er-parse-test "receive one clause" (pe "receive X -> X end") {:clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :guards (list)}) :type "receive" :after-ms nil :after-body (list)})
+
+(er-parse-test
+  "receive after"
+  (pe "receive X -> X after 1000 -> timeout end")
+  {:clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :guards (list)}) :type "receive" :after-ms {:value "1000" :type "integer"} :after-body (list {:value "timeout" :type "atom"})})
+
+(er-parse-test
+  "receive just after"
+  (pe "receive after 0 -> ok end")
+  {:clauses (list) :type "receive" :after-ms {:value "0" :type "integer"} :after-body (list {:value "ok" :type "atom"})})
+
+(er-parse-test
+  "anonymous fun 1-clause"
+  (pe "fun (X) -> X * 2 end")
+  {:clauses (list {:patterns (list {:type "var" :name "X"}) :body (list {:args (list {:type "var" :name "X"} {:value "2" :type "integer"}) :type "op" :op "*"}) :guards (list) :name nil}) :type "fun"})
+
+(er-parse-test "begin/end block" (pe "begin 1, 2, 3 end") {:exprs (list {:value "1" :type "integer"} {:value "2" :type "integer"} {:value "3" :type "integer"}) :type "block"})
+
+(er-parse-test "try/catch" (pe "try foo() catch error:X -> X end") {:exprs (list {:args (list) :fun {:value "foo" :type "atom"} :type "call"}) :catch-clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :class {:value "error" :type "atom"} :guards (list)}) :type "try" :of-clauses (list) :after (list)})
+
+;; ── module-level ──────────────────────────────────────────────────
+(er-parse-test
+  "try catch default class"
+  (pe "try foo() catch X -> X end")
+  {:exprs (list {:args (list) :fun {:value "foo" :type "atom"} :type "call"}) :catch-clauses (list {:pattern {:type "var" :name "X"} :body (list {:type "var" :name "X"}) :class {:value "throw" :type "atom"} :guards (list)}) :type "try" :of-clauses (list) :after (list)})
+
+(er-parse-test "minimal module" (pm "-module(m).\nfoo(X) -> X.") {:functions (list {:arity 1 :clauses (list {:patterns (list {:type "var" :name "X"}) :body (list {:type "var" :name "X"}) :guards (list) :name "foo"}) :type "function" :name "foo"}) :type "module" :attrs (list) :name "m"})
+
+(er-parse-test
+  "module with export"
+  (let
+    ((m (pm "-module(m).\n-export([foo/1]).\nfoo(X) -> X.")))
+    (list
+      (get m :name)
+      (len (get m :attrs))
+      (get (nth (get m :attrs) 0) :name)
+      (len (get m :functions))))
+  (list "m" 1 "export" 1))
+
+(er-parse-test
+  "two-clause function"
+  (let
+    ((m (pm "-module(m).\nf(0) -> z; f(N) -> n.")))
+    (list (len (get (nth (get m :functions) 0) :clauses))))
+  (list 2))
+
+(er-parse-test
+  "multi-arg function"
+  (let
+    ((m (pm "-module(m).\nadd(X, Y) -> X + Y.")))
+    (list (get (nth (get m :functions) 0) :arity)))
+  (list 2))
+
+(er-parse-test
+  "zero-arity"
+  (let
+    ((m (pm "-module(m).\npi() -> 3.14.")))
+    (list (get (nth (get m :functions) 0) :arity)))
+  (list 0))
+
+(er-parse-test
+  "function with guard"
+  (let
+    ((m (pm "-module(m).\nabs(N) when N < 0 -> -N; abs(N) -> N.")))
+    (list
+      (len (get (nth (get m :functions) 0) :clauses))
+      (len
+        (get (nth (get (nth (get m :functions) 0) :clauses) 0) :guards))))
+  (list 2 1))
+
+;; ── combined programs ────────────────────────────────────────────
+(er-parse-test
+  "three-function module"
+  (let
+    ((m (pm "-module(m).\na() -> 1.\nb() -> 2.\nc() -> 3.")))
+    (list
+      (len (get m :functions))
+      (get (nth (get m :functions) 0) :name)
+      (get (nth (get m :functions) 1) :name)
+      (get (nth (get m :functions) 2) :name)))
+  (list 3 "a" "b" "c"))
+
+(er-parse-test
+  "factorial"
+  (let
+    ((m (pm "-module(fact).\n-export([fact/1]).\nfact(0) -> 1;\nfact(N) -> N * fact(N - 1).")))
+    (list
+      (get m :name)
+      (get (nth (get m :functions) 0) :arity)
+      (len (get (nth (get m :functions) 0) :clauses))))
+  (list "fact" 1 2))
+
+(er-parse-test
+  "ping-pong snippet"
+  (let
+    ((e (pe "receive ping -> Sender ! pong end")))
+    (list (get e :type) (len (get e :clauses))))
+  (list "receive" 1))
+
+(er-parse-test
+  "case with nested tuple"
+  (let
+    ((e (pe "case X of {ok, V} -> V; error -> 0 end")))
+    (list (get e :type) (len (get e :clauses))))
+  (list "case" 2))
+
+;; ── summary ──────────────────────────────────────────────────────
+(er-parse-test
+  "deep expression"
+  (let ((e (pe "A + B * C - D / E"))) (get e :op))
+  "-")
+
+(define
+  er-parse-test-summary
+  (str "parser " er-parse-test-pass "/" er-parse-test-count))

lib/erlang/tests/tokenize.sx

@@ -0,0 +1,245 @@
+;; Erlang tokenizer tests
+
+(define er-test-count 0)
+(define er-test-pass 0)
+(define er-test-fails (list))
+
+(define tok-type (fn (t) (get t :type)))
+(define tok-value (fn (t) (get t :value)))
+
+(define tok-types (fn (src) (map tok-type (er-tokenize src))))
+
+(define tok-values (fn (src) (map tok-value (er-tokenize src))))
+
+(define
+  er-test
+  (fn
+    (name actual expected)
+    (set! er-test-count (+ er-test-count 1))
+    (if
+      (= actual expected)
+      (set! er-test-pass (+ er-test-pass 1))
+      (append! er-test-fails {:actual actual :expected expected :name name}))))
+
+;; ── atoms ─────────────────────────────────────────────────────────
+(er-test "atom: bare" (tok-values "foo") (list "foo" nil))
+
+(er-test
+  "atom: snake_case"
+  (tok-values "hello_world")
+  (list "hello_world" nil))
+
+(er-test
+  "atom: quoted"
+  (tok-values "'Hello World'")
+  (list "Hello World" nil))
+
+(er-test
+  "atom: quoted with special chars"
+  (tok-values "'foo-bar'")
+  (list "foo-bar" nil))
+
+(er-test "atom: with @" (tok-values "node@host") (list "node@host" nil))
+
+(er-test
+  "atom: type is atom"
+  (tok-types "foo bar baz")
+  (list "atom" "atom" "atom" "eof"))
+
+;; ── variables ─────────────────────────────────────────────────────
+(er-test "var: uppercase" (tok-values "X") (list "X" nil))
+
+(er-test "var: camelcase" (tok-values "FooBar") (list "FooBar" nil))
+
+(er-test "var: underscore" (tok-values "_") (list "_" nil))
+
+(er-test "var: _prefixed" (tok-values "_ignored") (list "_ignored" nil))
+
+(er-test "var: type" (tok-types "X Y _") (list "var" "var" "var" "eof"))
+
+;; ── integers ──────────────────────────────────────────────────────
+(er-test "integer: zero" (tok-values "0") (list "0" nil))
+
+(er-test "integer: positive" (tok-values "42") (list "42" nil))
+
+(er-test "integer: big" (tok-values "12345678") (list "12345678" nil))
+
+(er-test "integer: hex" (tok-values "16#FF") (list "16#FF" nil))
+
+(er-test
+  "integer: type"
+  (tok-types "1 2 3")
+  (list "integer" "integer" "integer" "eof"))
+
+(er-test "integer: char literal" (tok-types "$a") (list "integer" "eof"))
+
+(er-test
+  "integer: char literal escape"
+  (tok-types "$\\n")
+  (list "integer" "eof"))
+
+;; ── floats ────────────────────────────────────────────────────────
+(er-test "float: simple" (tok-values "3.14") (list "3.14" nil))
+
+(er-test "float: exponent" (tok-values "1.0e10") (list "1.0e10" nil))
+
+(er-test "float: neg exponent" (tok-values "1.5e-3") (list "1.5e-3" nil))
+
+(er-test "float: type" (tok-types "3.14") (list "float" "eof"))
+
+;; ── strings ───────────────────────────────────────────────────────
+(er-test "string: simple" (tok-values "\"hello\"") (list "hello" nil))
+
+(er-test "string: empty" (tok-values "\"\"") (list "" nil))
+
+(er-test "string: escape newline" (tok-values "\"a\\nb\"") (list "a\nb" nil))
+
+(er-test "string: type" (tok-types "\"hello\"") (list "string" "eof"))
+
+;; ── keywords ──────────────────────────────────────────────────────
+(er-test "keyword: case" (tok-types "case") (list "keyword" "eof"))
+
+(er-test
+  "keyword: of end when"
+  (tok-types "of end when")
+  (list "keyword" "keyword" "keyword" "eof"))
+
+(er-test
+  "keyword: receive after"
+  (tok-types "receive after")
+  (list "keyword" "keyword" "eof"))
+
+(er-test
+  "keyword: fun try catch"
+  (tok-types "fun try catch")
+  (list "keyword" "keyword" "keyword" "eof"))
+
+(er-test
+  "keyword: andalso orelse not"
+  (tok-types "andalso orelse not")
+  (list "keyword" "keyword" "keyword" "eof"))
+
+(er-test
+  "keyword: div rem"
+  (tok-types "div rem")
+  (list "keyword" "keyword" "eof"))
+
+;; ── punct ─────────────────────────────────────────────────────────
+(er-test "punct: parens" (tok-values "()") (list "(" ")" nil))
+
+(er-test "punct: braces" (tok-values "{}") (list "{" "}" nil))
+
+(er-test "punct: brackets" (tok-values "[]") (list "[" "]" nil))
+
+(er-test
+  "punct: commas"
+  (tok-types "a,b")
+  (list "atom" "punct" "atom" "eof"))
+
+(er-test
+  "punct: semicolon"
+  (tok-types "a;b")
+  (list "atom" "punct" "atom" "eof"))
+
+(er-test "punct: period" (tok-types "a.") (list "atom" "punct" "eof"))
+
+(er-test "punct: arrow" (tok-values "->") (list "->" nil))
+
+(er-test "punct: backarrow" (tok-values "<-") (list "<-" nil))
+
+(er-test "punct: binary brackets" (tok-values "<<>>") (list "<<" ">>" nil))
+
+(er-test
+  "punct: cons bar"
+  (tok-values "[a|b]")
+  (list "[" "a" "|" "b" "]" nil))
+
+(er-test "punct: double-bar (list comp)" (tok-values "||") (list "||" nil))
+
+(er-test "punct: double-colon" (tok-values "::") (list "::" nil))
+
+(er-test
+  "punct: module-colon"
+  (tok-values "lists:map")
+  (list "lists" ":" "map" nil))
+
+;; ── operators ─────────────────────────────────────────────────────
+(er-test
+  "op: plus minus times div"
+  (tok-values "+ - * /")
+  (list "+" "-" "*" "/" nil))
+
+(er-test
+  "op: eq/neq"
+  (tok-values "== /= =:= =/=")
+  (list "==" "/=" "=:=" "=/=" nil))
+
+(er-test "op: compare" (tok-values "< > =< >=") (list "<" ">" "=<" ">=" nil))
+
+(er-test "op: list ops" (tok-values "++ --") (list "++" "--" nil))
+
+(er-test "op: send" (tok-values "!") (list "!" nil))
+
+(er-test "op: match" (tok-values "=") (list "=" nil))
+
+;; ── comments ──────────────────────────────────────────────────────
+(er-test
+  "comment: ignored"
+  (tok-values "x % this is a comment\ny")
+  (list "x" "y" nil))
+
+(er-test
+  "comment: end-of-file"
+  (tok-values "x % comment to eof")
+  (list "x" nil))
+
+;; ── combined ──────────────────────────────────────────────────────
+(er-test
+  "combined: function head"
+  (tok-values "foo(X, Y) -> X + Y.")
+  (list "foo" "(" "X" "," "Y" ")" "->" "X" "+" "Y" "." nil))
+
+(er-test
+  "combined: case expression"
+  (tok-values "case X of 1 -> ok; _ -> err end")
+  (list "case" "X" "of" "1" "->" "ok" ";" "_" "->" "err" "end" nil))
+
+(er-test
+  "combined: tuple"
+  (tok-values "{ok, 42}")
+  (list "{" "ok" "," "42" "}" nil))
+
+(er-test
+  "combined: list cons"
+  (tok-values "[H|T]")
+  (list "[" "H" "|" "T" "]" nil))
+
+(er-test
+  "combined: receive"
+  (tok-values "receive X -> X end")
+  (list "receive" "X" "->" "X" "end" nil))
+
+(er-test
+  "combined: guard"
+  (tok-values "when is_integer(X)")
+  (list "when" "is_integer" "(" "X" ")" nil))
+
+(er-test
+  "combined: module attr"
+  (tok-values "-module(foo).")
+  (list "-" "module" "(" "foo" ")" "." nil))
+
+(er-test
+  "combined: send"
+  (tok-values "Pid ! {self(), hello}")
+  (list "Pid" "!" "{" "self" "(" ")" "," "hello" "}" nil))
+
+(er-test
+  "combined: whitespace skip"
+  (tok-values "  a  \n  b  \t  c  ")
+  (list "a" "b" "c" nil))
+
+;; ── report ────────────────────────────────────────────────────────
+(define
+  er-tokenize-test-summary
+  (str "tokenizer " er-test-pass "/" er-test-count))

lib/erlang/tokenizer.sx

@@ -0,0 +1,334 @@
+;; Erlang tokenizer — produces token stream from Erlang source
+;;
+;; Tokens: {:type T :value V :pos P}
+;; Types:
+;;   "atom"        — foo, 'Quoted Atom'
+;;   "var"         — X, Foo, _Bar, _ (wildcard)
+;;   "integer"     — 42, 16#FF, $c (char literal)
+;;   "float"       — 3.14, 1.0e10
+;;   "string"      — "..."
+;;   "keyword"     — case of end if when receive after fun try catch
+;;                   begin do let module export import define andalso orelse
+;;                   not div rem bnot band bor bxor bsl bsr
+;;   "punct"       — ( ) { } [ ] , ; . : :: -> <- <= => | ||
+;;                   << >>
+;;   "op"          — + - * / = == /= =:= =/= < > =< >= ++ -- ! ?
+;;   "eof"
+
+(define er-make-token (fn (type value pos) {:pos pos :value value :type type}))
+
+(define er-digit? (fn (c) (and (>= c "0") (<= c "9"))))
+
+(define
+  er-hex-digit?
+  (fn
+    (c)
+    (or
+      (er-digit? c)
+      (and (>= c "a") (<= c "f"))
+      (and (>= c "A") (<= c "F")))))
+
+(define er-lower? (fn (c) (and (>= c "a") (<= c "z"))))
+
+(define er-upper? (fn (c) (and (>= c "A") (<= c "Z"))))
+
+(define er-letter? (fn (c) (or (er-lower? c) (er-upper? c))))
+
+(define
+  er-ident-char?
+  (fn (c) (or (er-letter? c) (er-digit? c) (= c "_") (= c "@"))))
+
+(define er-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
+
+;; Erlang reserved words — everything else starting lowercase is an atom
+(define
+  er-keywords
+  (list
+    "after"
+    "and"
+    "andalso"
+    "band"
+    "begin"
+    "bnot"
+    "bor"
+    "bsl"
+    "bsr"
+    "bxor"
+    "case"
+    "catch"
+    "cond"
+    "div"
+    "end"
+    "fun"
+    "if"
+    "let"
+    "not"
+    "of"
+    "or"
+    "orelse"
+    "receive"
+    "rem"
+    "try"
+    "when"
+    "xor"))
+
+(define er-keyword? (fn (word) (some (fn (k) (= k word)) er-keywords)))
+
+(define
+  er-tokenize
+  (fn
+    (src)
+    (let
+      ((tokens (list)) (pos 0) (src-len (len src)))
+      (define
+        er-peek
+        (fn
+          (offset)
+          (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
+      (define er-cur (fn () (er-peek 0)))
+      (define er-advance! (fn (n) (set! pos (+ pos n))))
+      (define
+        skip-ws!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (er-ws? (er-cur)))
+            (er-advance! 1)
+            (skip-ws!))))
+      (define
+        skip-comment!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (not (= (er-cur) "\n")))
+            (er-advance! 1)
+            (skip-comment!))))
+      (define
+        read-ident-chars
+        (fn
+          (start)
+          (when
+            (and (< pos src-len) (er-ident-char? (er-cur)))
+            (er-advance! 1)
+            (read-ident-chars start))
+          (slice src start pos)))
+      (define
+        read-integer-digits
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (er-digit? (er-cur)))
+            (er-advance! 1)
+            (read-integer-digits))))
+      (define
+        read-hex-digits
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (er-hex-digit? (er-cur)))
+            (er-advance! 1)
+            (read-hex-digits))))
+      (define
+        read-number
+        (fn
+          (start)
+          (read-integer-digits)
+          (cond
+            (and
+              (< pos src-len)
+              (= (er-cur) "#")
+              (< (+ pos 1) src-len)
+              (er-hex-digit? (er-peek 1)))
+            (do (er-advance! 1) (read-hex-digits) {:value (slice src start pos) :type "integer"})
+            (and
+              (< pos src-len)
+              (= (er-cur) ".")
+              (< (+ pos 1) src-len)
+              (er-digit? (er-peek 1)))
+            (do
+              (er-advance! 1)
+              (read-integer-digits)
+              (when
+                (and
+                  (< pos src-len)
+                  (or (= (er-cur) "e") (= (er-cur) "E")))
+                (er-advance! 1)
+                (when
+                  (and
+                    (< pos src-len)
+                    (or (= (er-cur) "+") (= (er-cur) "-")))
+                  (er-advance! 1))
+                (read-integer-digits))
+              {:value (slice src start pos) :type "float"})
+            :else {:value (slice src start pos) :type "integer"})))
+      (define
+        read-string
+        (fn
+          (quote-char)
+          (let
+            ((chars (list)))
+            (er-advance! 1)
+            (define
+              loop
+              (fn
+                ()
+                (cond
+                  (>= pos src-len)
+                  nil
+                  (= (er-cur) "\\")
+                  (do
+                    (er-advance! 1)
+                    (when
+                      (< pos src-len)
+                      (let
+                        ((ch (er-cur)))
+                        (cond
+                          (= ch "n")
+                          (append! chars "\n")
+                          (= ch "t")
+                          (append! chars "\t")
+                          (= ch "r")
+                          (append! chars "\r")
+                          (= ch "\\")
+                          (append! chars "\\")
+                          (= ch "\"")
+                          (append! chars "\"")
+                          (= ch "'")
+                          (append! chars "'")
+                          :else (append! chars ch))
+                        (er-advance! 1)))
+                    (loop))
+                  (= (er-cur) quote-char)
+                  (er-advance! 1)
+                  :else (do (append! chars (er-cur)) (er-advance! 1) (loop)))))
+            (loop)
+            (join "" chars))))
+      (define
+        er-emit!
+        (fn
+          (type value start)
+          (append! tokens (er-make-token type value start))))
+      (define
+        scan!
+        (fn
+          ()
+          (skip-ws!)
+          (when
+            (< pos src-len)
+            (let
+              ((ch (er-cur)) (start pos))
+              (cond
+                (= ch "%")
+                (do (skip-comment!) (scan!))
+                (er-digit? ch)
+                (do
+                  (let
+                    ((tok (read-number start)))
+                    (er-emit! (get tok :type) (get tok :value) start))
+                  (scan!))
+                (= ch "$")
+                (do
+                  (er-advance! 1)
+                  (if
+                    (and (< pos src-len) (= (er-cur) "\\"))
+                    (do
+                      (er-advance! 1)
+                      (when (< pos src-len) (er-advance! 1)))
+                    (when (< pos src-len) (er-advance! 1)))
+                  (er-emit! "integer" (slice src start pos) start)
+                  (scan!))
+                (er-lower? ch)
+                (do
+                  (let
+                    ((word (read-ident-chars start)))
+                    (er-emit!
+                      (if (er-keyword? word) "keyword" "atom")
+                      word
+                      start))
+                  (scan!))
+                (or (er-upper? ch) (= ch "_"))
+                (do
+                  (let
+                    ((word (read-ident-chars start)))
+                    (er-emit! "var" word start))
+                  (scan!))
+                (= ch "'")
+                (do (er-emit! "atom" (read-string "'") start) (scan!))
+                (= ch "\"")
+                (do (er-emit! "string" (read-string "\"") start) (scan!))
+                (and (= ch "<") (= (er-peek 1) "<"))
+                (do (er-emit! "punct" "<<" start) (er-advance! 2) (scan!))
+                (and (= ch ">") (= (er-peek 1) ">"))
+                (do (er-emit! "punct" ">>" start) (er-advance! 2) (scan!))
+                (and (= ch "-") (= (er-peek 1) ">"))
+                (do (er-emit! "punct" "->" start) (er-advance! 2) (scan!))
+                (and (= ch "<") (= (er-peek 1) "-"))
+                (do (er-emit! "punct" "<-" start) (er-advance! 2) (scan!))
+                (and (= ch "<") (= (er-peek 1) "="))
+                (do (er-emit! "punct" "<=" start) (er-advance! 2) (scan!))
+                (and (= ch "=") (= (er-peek 1) ">"))
+                (do (er-emit! "punct" "=>" start) (er-advance! 2) (scan!))
+                (and (= ch "=") (= (er-peek 1) ":") (= (er-peek 2) "="))
+                (do (er-emit! "op" "=:=" start) (er-advance! 3) (scan!))
+                (and (= ch "=") (= (er-peek 1) "/") (= (er-peek 2) "="))
+                (do (er-emit! "op" "=/=" start) (er-advance! 3) (scan!))
+                (and (= ch "=") (= (er-peek 1) "="))
+                (do (er-emit! "op" "==" start) (er-advance! 2) (scan!))
+                (and (= ch "/") (= (er-peek 1) "="))
+                (do (er-emit! "op" "/=" start) (er-advance! 2) (scan!))
+                (and (= ch "=") (= (er-peek 1) "<"))
+                (do (er-emit! "op" "=<" start) (er-advance! 2) (scan!))
+                (and (= ch ">") (= (er-peek 1) "="))
+                (do (er-emit! "op" ">=" start) (er-advance! 2) (scan!))
+                (and (= ch "+") (= (er-peek 1) "+"))
+                (do (er-emit! "op" "++" start) (er-advance! 2) (scan!))
+                (and (= ch "-") (= (er-peek 1) "-"))
+                (do (er-emit! "op" "--" start) (er-advance! 2) (scan!))
+                (and (= ch ":") (= (er-peek 1) ":"))
+                (do (er-emit! "punct" "::" start) (er-advance! 2) (scan!))
+                (and (= ch "|") (= (er-peek 1) "|"))
+                (do (er-emit! "punct" "||" start) (er-advance! 2) (scan!))
+                (= ch "(")
+                (do (er-emit! "punct" "(" start) (er-advance! 1) (scan!))
+                (= ch ")")
+                (do (er-emit! "punct" ")" start) (er-advance! 1) (scan!))
+                (= ch "{")
+                (do (er-emit! "punct" "{" start) (er-advance! 1) (scan!))
+                (= ch "}")
+                (do (er-emit! "punct" "}" start) (er-advance! 1) (scan!))
+                (= ch "[")
+                (do (er-emit! "punct" "[" start) (er-advance! 1) (scan!))
+                (= ch "]")
+                (do (er-emit! "punct" "]" start) (er-advance! 1) (scan!))
+                (= ch ",")
+                (do (er-emit! "punct" "," start) (er-advance! 1) (scan!))
+                (= ch ";")
+                (do (er-emit! "punct" ";" start) (er-advance! 1) (scan!))
+                (= ch ".")
+                (do (er-emit! "punct" "." start) (er-advance! 1) (scan!))
+                (= ch ":")
+                (do (er-emit! "punct" ":" start) (er-advance! 1) (scan!))
+                (= ch "|")
+                (do (er-emit! "punct" "|" start) (er-advance! 1) (scan!))
+                (= ch "+")
+                (do (er-emit! "op" "+" start) (er-advance! 1) (scan!))
+                (= ch "-")
+                (do (er-emit! "op" "-" start) (er-advance! 1) (scan!))
+                (= ch "*")
+                (do (er-emit! "op" "*" start) (er-advance! 1) (scan!))
+                (= ch "/")
+                (do (er-emit! "op" "/" start) (er-advance! 1) (scan!))
+                (= ch "=")
+                (do (er-emit! "op" "=" start) (er-advance! 1) (scan!))
+                (= ch "<")
+                (do (er-emit! "op" "<" start) (er-advance! 1) (scan!))
+                (= ch ">")
+                (do (er-emit! "op" ">" start) (er-advance! 1) (scan!))
+                (= ch "!")
+                (do (er-emit! "op" "!" start) (er-advance! 1) (scan!))
+                (= ch "?")
+                (do (er-emit! "op" "?" start) (er-advance! 1) (scan!))
+                :else (do (er-advance! 1) (scan!)))))))
+      (scan!)
+      (er-emit! "eof" nil pos)
+      tokens)))

lib/forth/compiler.sx

@@ -0,0 +1,274 @@
+;; Phase 2 — colon definitions, compile mode, VARIABLE/CONSTANT/VALUE/TO, @/!/+!.
+;;
+;; Compile-mode representation:
+;;   A colon-definition body is a list of "ops", each an SX lambda (fn (s) ...).
+;;   : FOO 1 2 + ;    -> body = (push-1 push-2 call-plus)
+;;   References to other words are compiled as late-binding thunks so that
+;;   self-reference works and redefinitions take effect for future runs.
+;;
+;; State additions used in Phase 2:
+;;   "compiling"   : bool — are we inside :..; ?
+;;   "current-def" : dict {:name "..." :body (list)} during compile
+;;   "vars"        : dict {"addr-name" -> cell-value} for VARIABLE storage
+
+(define
+  forth-compile-token
+  (fn
+    (state tok)
+    (let
+      ((w (forth-lookup state tok)))
+      (if
+        (not (nil? w))
+        (if
+          (get w "immediate?")
+          (forth-execute-word state w)
+          (forth-compile-call state tok))
+        (let
+          ((n (forth-parse-number tok (get state "base"))))
+          (if
+            (not (nil? n))
+            (forth-compile-lit state n)
+            (forth-error state (str tok " ?"))))))))
+
+(define
+  forth-compile-call
+  (fn
+    (state name)
+    (let
+      ((op (fn (s) (let ((w (forth-lookup s name))) (if (nil? w) (forth-error s (str name " ? (compiled)")) (forth-execute-word s w))))))
+      (forth-def-append! state op))))
+
+(define
+  forth-compile-lit
+  (fn
+    (state n)
+    (let ((op (fn (s) (forth-push s n)))) (forth-def-append! state op))))
+
+(define
+  forth-def-append!
+  (fn
+    (state op)
+    (let
+      ((def (get state "current-def")))
+      (dict-set! def "body" (concat (get def "body") (list op))))))
+
+(define
+  forth-make-colon-body
+  (fn (ops) (fn (s) (for-each (fn (op) (op s)) ops))))
+
+;; Override forth-interpret-token to branch on compile mode.
+(define
+  forth-interpret-token
+  (fn
+    (state tok)
+    (if
+      (get state "compiling")
+      (forth-compile-token state tok)
+      (let
+        ((w (forth-lookup state tok)))
+        (if
+          (not (nil? w))
+          (forth-execute-word state w)
+          (let
+            ((n (forth-parse-number tok (get state "base"))))
+            (if
+              (not (nil? n))
+              (forth-push state n)
+              (forth-error state (str tok " ?")))))))))
+
+;; Install `:` and `;` plus VARIABLE, CONSTANT, VALUE, TO, @, !, +!, RECURSE.
+(define
+  forth-install-compiler!
+  (fn
+    (state)
+    (forth-def-prim!
+      state
+      ":"
+      (fn
+        (s)
+        (let
+          ((name (forth-next-token! s)))
+          (when (nil? name) (forth-error s ": expects name"))
+          (let
+            ((def (dict)))
+            (dict-set! def "name" name)
+            (dict-set! def "body" (list))
+            (dict-set! s "current-def" def)
+            (dict-set! s "compiling" true)))))
+    (forth-def-prim-imm!
+      state
+      ";"
+      (fn
+        (s)
+        (let
+          ((def (get s "current-def")))
+          (when (nil? def) (forth-error s "; outside definition"))
+          (let
+            ((ops (get def "body")))
+            (let
+              ((body-fn (forth-make-colon-body ops)))
+              (dict-set!
+                (get s "dict")
+                (downcase (get def "name"))
+                (forth-make-word "colon-def" body-fn false))
+              (dict-set! s "current-def" nil)
+              (dict-set! s "compiling" false))))))
+    (forth-def-prim-imm!
+      state
+      "IMMEDIATE"
+      (fn
+        (s)
+        (let
+          ((def-name (get (get s "current-def") "name"))
+            (target
+              (if
+                (nil? (get s "current-def"))
+                (forth-last-defined s)
+                (get (get s "current-def") "name"))))
+          (let
+            ((w (forth-lookup s target)))
+            (when (not (nil? w)) (dict-set! w "immediate?" true))))))
+    (forth-def-prim-imm!
+      state
+      "RECURSE"
+      (fn
+        (s)
+        (when
+          (not (get s "compiling"))
+          (forth-error s "RECURSE only in definition"))
+        (let
+          ((name (get (get s "current-def") "name")))
+          (forth-compile-call s name))))
+    (forth-def-prim!
+      state
+      "VARIABLE"
+      (fn
+        (s)
+        (let
+          ((name (forth-next-token! s)))
+          (when (nil? name) (forth-error s "VARIABLE expects name"))
+          (dict-set! (get s "vars") (downcase name) 0)
+          (forth-def-prim!
+            s
+            name
+            (fn (ss) (forth-push ss (downcase name)))))))
+    (forth-def-prim!
+      state
+      "CONSTANT"
+      (fn
+        (s)
+        (let
+          ((name (forth-next-token! s)) (v (forth-pop s)))
+          (when (nil? name) (forth-error s "CONSTANT expects name"))
+          (forth-def-prim! s name (fn (ss) (forth-push ss v))))))
+    (forth-def-prim!
+      state
+      "VALUE"
+      (fn
+        (s)
+        (let
+          ((name (forth-next-token! s)) (v (forth-pop s)))
+          (when (nil? name) (forth-error s "VALUE expects name"))
+          (dict-set! (get s "vars") (downcase name) v)
+          (forth-def-prim!
+            s
+            name
+            (fn
+              (ss)
+              (forth-push ss (get (get ss "vars") (downcase name))))))))
+    (forth-def-prim!
+      state
+      "TO"
+      (fn
+        (s)
+        (let
+          ((name (forth-next-token! s)) (v (forth-pop s)))
+          (when (nil? name) (forth-error s "TO expects name"))
+          (dict-set! (get s "vars") (downcase name) v))))
+    (forth-def-prim!
+      state
+      "@"
+      (fn
+        (s)
+        (let
+          ((addr (forth-pop s)))
+          (forth-push s (or (get (get s "vars") addr) 0)))))
+    (forth-def-prim!
+      state
+      "!"
+      (fn
+        (s)
+        (let
+          ((addr (forth-pop s)) (v (forth-pop s)))
+          (dict-set! (get s "vars") addr v))))
+    (forth-def-prim!
+      state
+      "+!"
+      (fn
+        (s)
+        (let
+          ((addr (forth-pop s)) (v (forth-pop s)))
+          (let
+            ((cur (or (get (get s "vars") addr) 0)))
+            (dict-set! (get s "vars") addr (+ cur v))))))
+    state))
+
+;; Track the most recently defined word name for IMMEDIATE.
+(define forth-last-defined (fn (state) (get state "last-defined")))
+
+;; forth-next-token!: during `:`, VARIABLE, CONSTANT, etc. we need to pull
+;; the next token from the *input stream* (not the dict/stack). Phase-1
+;; interpreter fed tokens one at a time via for-each, so a parsing word
+;; can't reach ahead. We rework `forth-interpret` to keep the remaining
+;; token list on the state so parsing words can consume from it.
+
+(define
+  forth-next-token!
+  (fn
+    (state)
+    (let
+      ((rest (get state "input")))
+      (if
+        (or (nil? rest) (= (len rest) 0))
+        nil
+        (let
+          ((tok (first rest)))
+          (dict-set! state "input" (rest-of rest))
+          tok)))))
+
+(define rest-of (fn (l) (rest l)))
+
+;; Rewritten forth-interpret: drives a token list stored in state so that
+;; parsing words like `:`, `VARIABLE`, `CONSTANT`, `TO` can consume the
+;; following token.
+(define
+  forth-interpret
+  (fn
+    (state src)
+    (dict-set! state "input" (forth-tokens src))
+    (forth-interpret-loop state)
+    state))
+
+(define
+  forth-interpret-loop
+  (fn
+    (state)
+    (let
+      ((tok (forth-next-token! state)))
+      (if
+        (nil? tok)
+        state
+        (begin
+          (forth-interpret-token state tok)
+          (forth-interpret-loop state))))))
+
+;; Re-export forth-boot to include the compiler primitives too.
+(define
+  forth-boot
+  (fn
+    ()
+    (let
+      ((s (forth-make-state)))
+      (forth-install-primitives! s)
+      (forth-install-compiler! s)
+      s)))

lib/forth/interpreter.sx

@@ -0,0 +1,48 @@
+;; Forth interpreter loop — interpret mode only (Phase 1).
+;; Reads whitespace-delimited words, looks them up, executes.
+;; Numbers (parsed via BASE) push onto the data stack.
+;; Unknown words raise "?".
+
+(define
+  forth-execute-word
+  (fn (state word) (let ((body (get word "body"))) (body state))))
+
+(define
+  forth-interpret-token
+  (fn
+    (state tok)
+    (let
+      ((w (forth-lookup state tok)))
+      (if
+        (not (nil? w))
+        (forth-execute-word state w)
+        (let
+          ((n (forth-parse-number tok (get state "base"))))
+          (if
+            (not (nil? n))
+            (forth-push state n)
+            (forth-error state (str tok " ?"))))))))
+
+(define
+  forth-interpret
+  (fn
+    (state src)
+    (for-each
+      (fn (tok) (forth-interpret-token state tok))
+      (forth-tokens src))
+    state))
+
+;; Convenience: build a fresh state with primitives loaded.
+(define
+  forth-boot
+  (fn () (let ((s (forth-make-state))) (forth-install-primitives! s) s)))
+
+;; Run source on a fresh state and return (state, output, stack-top-to-bottom).
+(define
+  forth-run
+  (fn
+    (src)
+    (let
+      ((s (forth-boot)))
+      (forth-interpret s src)
+      (list s (get s "output") (reverse (get s "dstack"))))))

lib/forth/reader.sx

@@ -0,0 +1,104 @@
+;; Forth reader — whitespace-delimited tokens.
+
+(define
+  forth-whitespace?
+  (fn (ch) (or (= ch " ") (or (= ch "\t") (or (= ch "\n") (= ch "\r"))))))
+
+(define
+  forth-tokens-loop
+  (fn
+    (src n i buf out)
+    (if
+      (>= i n)
+      (if (> (len buf) 0) (concat out (list buf)) out)
+      (let
+        ((ch (char-at src i)))
+        (if
+          (forth-whitespace? ch)
+          (if
+            (> (len buf) 0)
+            (forth-tokens-loop src n (+ i 1) "" (concat out (list buf)))
+            (forth-tokens-loop src n (+ i 1) buf out))
+          (forth-tokens-loop src n (+ i 1) (str buf ch) out))))))
+
+(define
+  forth-tokens
+  (fn (src) (forth-tokens-loop src (len src) 0 "" (list))))
+
+(define
+  forth-digit-value
+  (fn
+    (ch base)
+    (let
+      ((code (char-code ch)) (cc (char-code (downcase ch))))
+      (let
+        ((v (if (and (>= code 48) (<= code 57)) (- code 48) (if (and (>= cc 97) (<= cc 122)) (+ 10 (- cc 97)) -1))))
+        (if (and (>= v 0) (< v base)) v nil)))))
+
+(define
+  forth-parse-digits-loop
+  (fn
+    (src n i base acc)
+    (if
+      (>= i n)
+      acc
+      (let
+        ((d (forth-digit-value (char-at src i) base)))
+        (if
+          (nil? d)
+          nil
+          (forth-parse-digits-loop src n (+ i 1) base (+ (* acc base) d)))))))
+
+(define
+  forth-parse-digits
+  (fn
+    (src base)
+    (if
+      (= (len src) 0)
+      nil
+      (forth-parse-digits-loop src (len src) 0 base 0))))
+
+(define
+  forth-strip-prefix
+  (fn
+    (s)
+    (if
+      (<= (len s) 1)
+      (list s 0)
+      (let
+        ((c (char-at s 0)))
+        (if
+          (= c "$")
+          (list (substring s 1 (len s)) 16)
+          (if
+            (= c "%")
+            (list (substring s 1 (len s)) 2)
+            (if (= c "#") (list (substring s 1 (len s)) 10) (list s 0))))))))
+
+(define
+  forth-parse-number
+  (fn
+    (tok base)
+    (let
+      ((n (len tok)))
+      (if
+        (= n 0)
+        nil
+        (if
+          (and
+            (= n 3)
+            (and (= (char-at tok 0) "'") (= (char-at tok 2) "'")))
+          (char-code (char-at tok 1))
+          (let
+            ((neg? (and (> n 1) (= (char-at tok 0) "-"))))
+            (let
+              ((s1 (if neg? (substring tok 1 n) tok)))
+              (let
+                ((pair (forth-strip-prefix s1)))
+                (let
+                  ((s (first pair)) (b-override (nth pair 1)))
+                  (let
+                    ((b (if (= b-override 0) base b-override)))
+                    (let
+                      ((v (forth-parse-digits s b)))
+                      (if (nil? v) nil (if neg? (- 0 v) v)))))))))))))

lib/forth/runtime.sx

@@ -0,0 +1,433 @@
+;; Forth runtime — state, stacks, dictionary, output buffer.
+;; Data stack: mutable SX list, TOS = first.
+;; Return stack: separate mutable list.
+;; Dictionary: SX dict {lowercased-name -> word-record}.
+;; Word record: {"kind" "body" "immediate?"}; kind is "primitive" or "colon-def".
+;; Output buffer: mutable string appended to by `.`, `EMIT`, `CR`, etc.
+;; Compile-mode flag: "compiling" on the state.
+
+(define
+  forth-make-state
+  (fn
+    ()
+    (let
+      ((s (dict)))
+      (dict-set! s "dstack" (list))
+      (dict-set! s "rstack" (list))
+      (dict-set! s "dict" (dict))
+      (dict-set! s "output" "")
+      (dict-set! s "compiling" false)
+      (dict-set! s "current-def" nil)
+      (dict-set! s "base" 10)
+      (dict-set! s "vars" (dict))
+      s)))
+
+(define
+  forth-error
+  (fn (state msg) (dict-set! state "error" msg) (raise msg)))
+
+(define
+  forth-push
+  (fn (state v) (dict-set! state "dstack" (cons v (get state "dstack")))))
+
+(define
+  forth-pop
+  (fn
+    (state)
+    (let
+      ((st (get state "dstack")))
+      (if
+        (= (len st) 0)
+        (forth-error state "stack underflow")
+        (let ((top (first st))) (dict-set! state "dstack" (rest st)) top)))))
+
+(define
+  forth-peek
+  (fn
+    (state)
+    (let
+      ((st (get state "dstack")))
+      (if (= (len st) 0) (forth-error state "stack underflow") (first st)))))
+
+(define forth-depth (fn (state) (len (get state "dstack"))))
+
+(define
+  forth-rpush
+  (fn (state v) (dict-set! state "rstack" (cons v (get state "rstack")))))
+
+(define
+  forth-rpop
+  (fn
+    (state)
+    (let
+      ((st (get state "rstack")))
+      (if
+        (= (len st) 0)
+        (forth-error state "return stack underflow")
+        (let ((top (first st))) (dict-set! state "rstack" (rest st)) top)))))
+
+(define
+  forth-rpeek
+  (fn
+    (state)
+    (let
+      ((st (get state "rstack")))
+      (if
+        (= (len st) 0)
+        (forth-error state "return stack underflow")
+        (first st)))))
+
+(define
+  forth-emit-str
+  (fn (state s) (dict-set! state "output" (str (get state "output") s))))
+
+(define
+  forth-make-word
+  (fn
+    (kind body immediate?)
+    (let
+      ((w (dict)))
+      (dict-set! w "kind" kind)
+      (dict-set! w "body" body)
+      (dict-set! w "immediate?" immediate?)
+      w)))
+
+(define
+  forth-def-prim!
+  (fn
+    (state name body)
+    (dict-set!
+      (get state "dict")
+      (downcase name)
+      (forth-make-word "primitive" body false))))
+
+(define
+  forth-def-prim-imm!
+  (fn
+    (state name body)
+    (dict-set!
+      (get state "dict")
+      (downcase name)
+      (forth-make-word "primitive" body true))))
+
+(define
+  forth-lookup
+  (fn (state name) (get (get state "dict") (downcase name))))
+
+(define
+  forth-binop
+  (fn
+    (op)
+    (fn
+      (state)
+      (let
+        ((b (forth-pop state)) (a (forth-pop state)))
+        (forth-push state (op a b))))))
+
+(define
+  forth-unop
+  (fn
+    (op)
+    (fn (state) (let ((a (forth-pop state))) (forth-push state (op a))))))
+
+(define
+  forth-cmp
+  (fn
+    (op)
+    (fn
+      (state)
+      (let
+        ((b (forth-pop state)) (a (forth-pop state)))
+        (forth-push state (if (op a b) -1 0))))))
+
+(define
+  forth-cmp0
+  (fn
+    (op)
+    (fn
+      (state)
+      (let ((a (forth-pop state))) (forth-push state (if (op a) -1 0))))))
+
+(define
+  forth-trunc
+  (fn (x) (if (< x 0) (- 0 (floor (- 0 x))) (floor x))))
+
+(define
+  forth-div
+  (fn
+    (a b)
+    (if (= b 0) (raise "division by zero") (forth-trunc (/ a b)))))
+
+(define
+  forth-mod
+  (fn
+    (a b)
+    (if (= b 0) (raise "division by zero") (- a (* b (forth-div a b))))))
+
+(define forth-bits-width 32)
+
+(define
+  forth-to-unsigned
+  (fn (n w) (let ((m (pow 2 w))) (mod (+ (mod n m) m) m))))
+
+(define
+  forth-from-unsigned
+  (fn
+    (n w)
+    (let ((half (pow 2 (- w 1)))) (if (>= n half) (- n (pow 2 w)) n))))
+
+(define
+  forth-bitwise-step
+  (fn
+    (op ua ub out place i w)
+    (if
+      (>= i w)
+      out
+      (let
+        ((da (mod ua 2)) (db (mod ub 2)))
+        (forth-bitwise-step
+          op
+          (floor (/ ua 2))
+          (floor (/ ub 2))
+          (+ out (* place (op da db)))
+          (* place 2)
+          (+ i 1)
+          w)))))
+
+(define
+  forth-bitwise-uu
+  (fn
+    (op)
+    (fn
+      (a b)
+      (let
+        ((ua (forth-to-unsigned a forth-bits-width))
+          (ub (forth-to-unsigned b forth-bits-width)))
+        (forth-from-unsigned
+          (forth-bitwise-step op ua ub 0 1 0 forth-bits-width)
+          forth-bits-width)))))
+
+(define
+  forth-bit-and
+  (forth-bitwise-uu (fn (x y) (if (and (= x 1) (= y 1)) 1 0))))
+
+(define
+  forth-bit-or
+  (forth-bitwise-uu (fn (x y) (if (or (= x 1) (= y 1)) 1 0))))
+
+(define forth-bit-xor (forth-bitwise-uu (fn (x y) (if (= x y) 0 1))))
+
+(define forth-bit-invert (fn (a) (- 0 (+ a 1))))
+
+(define
+  forth-install-primitives!
+  (fn
+    (state)
+    (forth-def-prim! state "DUP" (fn (s) (forth-push s (forth-peek s))))
+    (forth-def-prim! state "DROP" (fn (s) (forth-pop s)))
+    (forth-def-prim!
+      state
+      "SWAP"
+      (fn
+        (s)
+        (let
+          ((b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s b)
+          (forth-push s a))))
+    (forth-def-prim!
+      state
+      "OVER"
+      (fn
+        (s)
+        (let
+          ((b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s a)
+          (forth-push s b)
+          (forth-push s a))))
+    (forth-def-prim!
+      state
+      "ROT"
+      (fn
+        (s)
+        (let
+          ((c (forth-pop s)) (b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s b)
+          (forth-push s c)
+          (forth-push s a))))
+    (forth-def-prim!
+      state
+      "-ROT"
+      (fn
+        (s)
+        (let
+          ((c (forth-pop s)) (b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s c)
+          (forth-push s a)
+          (forth-push s b))))
+    (forth-def-prim!
+      state
+      "NIP"
+      (fn (s) (let ((b (forth-pop s))) (forth-pop s) (forth-push s b))))
+    (forth-def-prim!
+      state
+      "TUCK"
+      (fn
+        (s)
+        (let
+          ((b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s b)
+          (forth-push s a)
+          (forth-push s b))))
+    (forth-def-prim!
+      state
+      "?DUP"
+      (fn
+        (s)
+        (let ((a (forth-peek s))) (when (not (= a 0)) (forth-push s a)))))
+    (forth-def-prim! state "DEPTH" (fn (s) (forth-push s (forth-depth s))))
+    (forth-def-prim!
+      state
+      "PICK"
+      (fn
+        (s)
+        (let
+          ((n (forth-pop s)) (st (get s "dstack")))
+          (if
+            (or (< n 0) (>= n (len st)))
+            (forth-error s "PICK out of range")
+            (forth-push s (nth st n))))))
+    (forth-def-prim!
+      state
+      "ROLL"
+      (fn
+        (s)
+        (let
+          ((n (forth-pop s)) (st (get s "dstack")))
+          (if
+            (or (< n 0) (>= n (len st)))
+            (forth-error s "ROLL out of range")
+            (let
+              ((taken (nth st n))
+                (before (take st n))
+                (after (drop st (+ n 1))))
+              (dict-set! s "dstack" (concat before after))
+              (forth-push s taken))))))
+    (forth-def-prim!
+      state
+      "2DUP"
+      (fn
+        (s)
+        (let
+          ((b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s a)
+          (forth-push s b)
+          (forth-push s a)
+          (forth-push s b))))
+    (forth-def-prim! state "2DROP" (fn (s) (forth-pop s) (forth-pop s)))
+    (forth-def-prim!
+      state
+      "2SWAP"
+      (fn
+        (s)
+        (let
+          ((d (forth-pop s))
+            (c (forth-pop s))
+            (b (forth-pop s))
+            (a (forth-pop s)))
+          (forth-push s c)
+          (forth-push s d)
+          (forth-push s a)
+          (forth-push s b))))
+    (forth-def-prim!
+      state
+      "2OVER"
+      (fn
+        (s)
+        (let
+          ((d (forth-pop s))
+            (c (forth-pop s))
+            (b (forth-pop s))
+            (a (forth-pop s)))
+          (forth-push s a)
+          (forth-push s b)
+          (forth-push s c)
+          (forth-push s d)
+          (forth-push s a)
+          (forth-push s b))))
+    (forth-def-prim! state "+" (forth-binop (fn (a b) (+ a b))))
+    (forth-def-prim! state "-" (forth-binop (fn (a b) (- a b))))
+    (forth-def-prim! state "*" (forth-binop (fn (a b) (* a b))))
+    (forth-def-prim! state "/" (forth-binop forth-div))
+    (forth-def-prim! state "MOD" (forth-binop forth-mod))
+    (forth-def-prim!
+      state
+      "/MOD"
+      (fn
+        (s)
+        (let
+          ((b (forth-pop s)) (a (forth-pop s)))
+          (forth-push s (forth-mod a b))
+          (forth-push s (forth-div a b)))))
+    (forth-def-prim! state "NEGATE" (forth-unop (fn (a) (- 0 a))))
+    (forth-def-prim! state "ABS" (forth-unop abs))
+    (forth-def-prim!
+      state
+      "MIN"
+      (forth-binop (fn (a b) (if (< a b) a b))))
+    (forth-def-prim!
+      state
+      "MAX"
+      (forth-binop (fn (a b) (if (> a b) a b))))
+    (forth-def-prim! state "1+" (forth-unop (fn (a) (+ a 1))))
+    (forth-def-prim! state "1-" (forth-unop (fn (a) (- a 1))))
+    (forth-def-prim! state "2+" (forth-unop (fn (a) (+ a 2))))
+    (forth-def-prim! state "2-" (forth-unop (fn (a) (- a 2))))
+    (forth-def-prim! state "2*" (forth-unop (fn (a) (* a 2))))
+    (forth-def-prim! state "2/" (forth-unop (fn (a) (floor (/ a 2)))))
+    (forth-def-prim! state "=" (forth-cmp (fn (a b) (= a b))))
+    (forth-def-prim! state "<>" (forth-cmp (fn (a b) (not (= a b)))))
+    (forth-def-prim! state "<" (forth-cmp (fn (a b) (< a b))))
+    (forth-def-prim! state ">" (forth-cmp (fn (a b) (> a b))))
+    (forth-def-prim! state "<=" (forth-cmp (fn (a b) (<= a b))))
+    (forth-def-prim! state ">=" (forth-cmp (fn (a b) (>= a b))))
+    (forth-def-prim! state "0=" (forth-cmp0 (fn (a) (= a 0))))
+    (forth-def-prim! state "0<>" (forth-cmp0 (fn (a) (not (= a 0)))))
+    (forth-def-prim! state "0<" (forth-cmp0 (fn (a) (< a 0))))
+    (forth-def-prim! state "0>" (forth-cmp0 (fn (a) (> a 0))))
+    (forth-def-prim! state "AND" (forth-binop forth-bit-and))
+    (forth-def-prim! state "OR" (forth-binop forth-bit-or))
+    (forth-def-prim! state "XOR" (forth-binop forth-bit-xor))
+    (forth-def-prim! state "INVERT" (forth-unop forth-bit-invert))
+    (forth-def-prim!
+      state
+      "."
+      (fn (s) (forth-emit-str s (str (forth-pop s) " "))))
+    (forth-def-prim!
+      state
+      ".S"
+      (fn
+        (s)
+        (let
+          ((st (reverse (get s "dstack"))))
+          (forth-emit-str s "<")
+          (forth-emit-str s (str (len st)))
+          (forth-emit-str s "> ")
+          (for-each (fn (v) (forth-emit-str s (str v " "))) st))))
+    (forth-def-prim!
+      state
+      "EMIT"
+      (fn (s) (forth-emit-str s (code-char (forth-pop s)))))
+    (forth-def-prim! state "CR" (fn (s) (forth-emit-str s "\n")))
+    (forth-def-prim! state "SPACE" (fn (s) (forth-emit-str s " ")))
+    (forth-def-prim!
+      state
+      "SPACES"
+      (fn
+        (s)
+        (let
+          ((n (forth-pop s)))
+          (when
+            (> n 0)
+            (for-each (fn (_) (forth-emit-str s " ")) (range 0 n))))))
+    (forth-def-prim! state "BL" (fn (s) (forth-push s 32)))
+    state))

lib/forth/tests/test-phase1.sx

@@ -0,0 +1,224 @@
+;; Phase 1 — reader + interpret mode + core words.
+;; Simple assertion driver: (forth-test label input expected-stack)
+;; forth-run returns (state, output, stack-bottom-to-top).
+
+(define forth-tests-passed 0)
+(define forth-tests-failed 0)
+(define forth-tests-failures (list))
+
+(define
+  forth-assert
+  (fn
+    (label expected actual)
+    (if
+      (= expected actual)
+      (set! forth-tests-passed (+ forth-tests-passed 1))
+      (begin
+        (set! forth-tests-failed (+ forth-tests-failed 1))
+        (set!
+          forth-tests-failures
+          (concat
+            forth-tests-failures
+            (list
+              (str label ": expected " (str expected) " got " (str actual)))))))))
+
+(define
+  forth-check-stack
+  (fn
+    (label src expected)
+    (let ((r (forth-run src))) (forth-assert label expected (nth r 2)))))
+
+(define
+  forth-check-output
+  (fn
+    (label src expected)
+    (let ((r (forth-run src))) (forth-assert label expected (nth r 1)))))
+
+(define
+  forth-reader-tests
+  (fn
+    ()
+    (forth-assert
+      "tokens split"
+      (list "1" "2" "+")
+      (forth-tokens "  1  2 +  "))
+    (forth-assert "tokens empty" (list) (forth-tokens ""))
+    (forth-assert
+      "tokens tab/newline"
+      (list "a" "b" "c")
+      (forth-tokens "a\tb\nc"))
+    (forth-assert "number decimal" 42 (forth-parse-number "42" 10))
+    (forth-assert "number negative" -7 (forth-parse-number "-7" 10))
+    (forth-assert "number hex prefix" 255 (forth-parse-number "$ff" 10))
+    (forth-assert "number binary prefix" 10 (forth-parse-number "%1010" 10))
+    (forth-assert
+      "number decimal override under hex base"
+      123
+      (forth-parse-number "#123" 16))
+    (forth-assert "number none" nil (forth-parse-number "abc" 10))
+    (forth-assert "number in hex base" 255 (forth-parse-number "ff" 16))
+    (forth-assert
+      "number negative hex prefix"
+      -16
+      (forth-parse-number "-$10" 10))
+    (forth-assert "char literal" 65 (forth-parse-number "'A'" 10))
+    (forth-assert
+      "mixed-case digit in base 10"
+      nil
+      (forth-parse-number "1A" 10))
+    (forth-assert
+      "mixed-case digit in base 16"
+      26
+      (forth-parse-number "1a" 16))))
+
+(define
+  forth-stack-tests
+  (fn
+    ()
+    (forth-check-stack "push literal" "42" (list 42))
+    (forth-check-stack "push multiple" "1 2 3" (list 1 2 3))
+    (forth-check-stack "DUP" "7 DUP" (list 7 7))
+    (forth-check-stack "DROP" "1 2 DROP" (list 1))
+    (forth-check-stack "SWAP" "1 2 SWAP" (list 2 1))
+    (forth-check-stack "OVER" "1 2 OVER" (list 1 2 1))
+    (forth-check-stack "ROT" "1 2 3 ROT" (list 2 3 1))
+    (forth-check-stack "-ROT" "1 2 3 -ROT" (list 3 1 2))
+    (forth-check-stack "NIP" "1 2 NIP" (list 2))
+    (forth-check-stack "TUCK" "1 2 TUCK" (list 2 1 2))
+    (forth-check-stack "?DUP non-zero" "5 ?DUP" (list 5 5))
+    (forth-check-stack "?DUP zero" "0 ?DUP" (list 0))
+    (forth-check-stack "DEPTH empty" "DEPTH" (list 0))
+    (forth-check-stack "DEPTH non-empty" "1 2 3 DEPTH" (list 1 2 3 3))
+    (forth-check-stack "PICK 0" "10 20 30 0 PICK" (list 10 20 30 30))
+    (forth-check-stack "PICK 1" "10 20 30 1 PICK" (list 10 20 30 20))
+    (forth-check-stack "PICK 2" "10 20 30 2 PICK" (list 10 20 30 10))
+    (forth-check-stack "ROLL 0 is no-op" "10 20 30 0 ROLL" (list 10 20 30))
+    (forth-check-stack "ROLL 2" "10 20 30 2 ROLL" (list 20 30 10))
+    (forth-check-stack "2DUP" "1 2 2DUP" (list 1 2 1 2))
+    (forth-check-stack "2DROP" "1 2 3 4 2DROP" (list 1 2))
+    (forth-check-stack "2SWAP" "1 2 3 4 2SWAP" (list 3 4 1 2))
+    (forth-check-stack "2OVER" "1 2 3 4 2OVER" (list 1 2 3 4 1 2))))
+
+(define
+  forth-arith-tests
+  (fn
+    ()
+    (forth-check-stack "+" "3 4 +" (list 7))
+    (forth-check-stack "-" "10 3 -" (list 7))
+    (forth-check-stack "*" "6 7 *" (list 42))
+    (forth-check-stack "/ positive" "7 2 /" (list 3))
+    (forth-check-stack "/ negative numerator" "-7 2 /" (list -3))
+    (forth-check-stack "/ both negative" "-7 -2 /" (list 3))
+    (forth-check-stack "MOD positive" "7 3 MOD" (list 1))
+    (forth-check-stack "MOD negative" "-7 3 MOD" (list -1))
+    (forth-check-stack "/MOD positive" "7 3 /MOD" (list 1 2))
+    (forth-check-stack "NEGATE" "5 NEGATE" (list -5))
+    (forth-check-stack "ABS negative" "-5 ABS" (list 5))
+    (forth-check-stack "ABS positive" "5 ABS" (list 5))
+    (forth-check-stack "MIN a<b" "3 5 MIN" (list 3))
+    (forth-check-stack "MIN a>b" "5 3 MIN" (list 3))
+    (forth-check-stack "MAX a<b" "3 5 MAX" (list 5))
+    (forth-check-stack "MAX a>b" "5 3 MAX" (list 5))
+    (forth-check-stack "1+" "5 1+" (list 6))
+    (forth-check-stack "1-" "5 1-" (list 4))
+    (forth-check-stack "2+" "5 2+" (list 7))
+    (forth-check-stack "2-" "5 2-" (list 3))
+    (forth-check-stack "2*" "5 2*" (list 10))
+    (forth-check-stack "2/" "7 2/" (list 3))))
+
+(define
+  forth-cmp-tests
+  (fn
+    ()
+    (forth-check-stack "= true" "5 5 =" (list -1))
+    (forth-check-stack "= false" "5 6 =" (list 0))
+    (forth-check-stack "<> true" "5 6 <>" (list -1))
+    (forth-check-stack "<> false" "5 5 <>" (list 0))
+    (forth-check-stack "< true" "3 5 <" (list -1))
+    (forth-check-stack "< false" "5 3 <" (list 0))
+    (forth-check-stack "> true" "5 3 >" (list -1))
+    (forth-check-stack "> false" "3 5 >" (list 0))
+    (forth-check-stack "<= equal" "5 5 <=" (list -1))
+    (forth-check-stack "<= less" "3 5 <=" (list -1))
+    (forth-check-stack ">= equal" "5 5 >=" (list -1))
+    (forth-check-stack ">= greater" "5 3 >=" (list -1))
+    (forth-check-stack "0= true" "0 0=" (list -1))
+    (forth-check-stack "0= false" "1 0=" (list 0))
+    (forth-check-stack "0<> true" "1 0<>" (list -1))
+    (forth-check-stack "0<> false" "0 0<>" (list 0))
+    (forth-check-stack "0< true" "-5 0<" (list -1))
+    (forth-check-stack "0< false" "5 0<" (list 0))
+    (forth-check-stack "0> true" "5 0>" (list -1))
+    (forth-check-stack "0> false" "-5 0>" (list 0))))
+
+(define
+  forth-bitwise-tests
+  (fn
+    ()
+    (forth-check-stack "AND flags" "-1 0 AND" (list 0))
+    (forth-check-stack "AND flags 2" "-1 -1 AND" (list -1))
+    (forth-check-stack "AND 12 10" "12 10 AND" (list 8))
+    (forth-check-stack "OR flags" "-1 0 OR" (list -1))
+    (forth-check-stack "OR 12 10" "12 10 OR" (list 14))
+    (forth-check-stack "XOR 12 10" "12 10 XOR" (list 6))
+    (forth-check-stack "XOR same" "15 15 XOR" (list 0))
+    (forth-check-stack "INVERT 0" "0 INVERT" (list -1))
+    (forth-check-stack "INVERT 5" "5 INVERT" (list -6))
+    (forth-check-stack "double INVERT" "7 INVERT INVERT" (list 7))))
+
+(define
+  forth-io-tests
+  (fn
+    ()
+    (forth-check-output "." "42 ." "42 ")
+    (forth-check-output ". two values" "1 2 . ." "2 1 ")
+    (forth-check-output ".S empty" ".S" "<0> ")
+    (forth-check-output ".S three" "1 2 3 .S" "<3> 1 2 3 ")
+    (forth-check-output "EMIT A" "65 EMIT" "A")
+    (forth-check-output "CR" "CR" "\n")
+    (forth-check-output "SPACE" "SPACE" " ")
+    (forth-check-output "SPACES 3" "3 SPACES" "   ")
+    (forth-check-output "SPACES 0" "0 SPACES" "")
+    (forth-check-stack "BL" "BL" (list 32))))
+
+(define
+  forth-case-tests
+  (fn
+    ()
+    (forth-check-stack "case-insensitive DUP" "5 dup" (list 5 5))
+    (forth-check-stack "case-insensitive SWAP" "1 2 Swap" (list 2 1))))
+
+(define
+  forth-mixed-tests
+  (fn
+    ()
+    (forth-check-stack "chained arith" "1 2 3 + +" (list 6))
+    (forth-check-stack "(3+4)*2" "3 4 + 2 *" (list 14))
+    (forth-check-stack "max of three" "5 3 MAX 7 MAX" (list 7))
+    (forth-check-stack "abs chain" "-5 ABS 1+" (list 6))
+    (forth-check-stack "swap then add" "5 7 SWAP -" (list 2))
+    (forth-check-stack "hex literal" "$10 $20 +" (list 48))
+    (forth-check-stack "binary literal" "%1010 %0011 +" (list 13))))
+
+(define
+  forth-run-all-phase1-tests
+  (fn
+    ()
+    (set! forth-tests-passed 0)
+    (set! forth-tests-failed 0)
+    (set! forth-tests-failures (list))
+    (forth-reader-tests)
+    (forth-stack-tests)
+    (forth-arith-tests)
+    (forth-cmp-tests)
+    (forth-bitwise-tests)
+    (forth-io-tests)
+    (forth-case-tests)
+    (forth-mixed-tests)
+    (dict
+      "passed"
+      forth-tests-passed
+      "failed"
+      forth-tests-failed
+      "failures"
+      forth-tests-failures)))

lib/forth/tests/test-phase2.sx

@@ -0,0 +1,146 @@
+;; Phase 2 — colon definitions + compile mode + variables/values/fetch/store.
+
+(define forth-p2-passed 0)
+(define forth-p2-failed 0)
+(define forth-p2-failures (list))
+
+(define
+  forth-p2-assert
+  (fn
+    (label expected actual)
+    (if
+      (= expected actual)
+      (set! forth-p2-passed (+ forth-p2-passed 1))
+      (begin
+        (set! forth-p2-failed (+ forth-p2-failed 1))
+        (set!
+          forth-p2-failures
+          (concat
+            forth-p2-failures
+            (list
+              (str label ": expected " (str expected) " got " (str actual)))))))))
+
+(define
+  forth-p2-check-stack
+  (fn
+    (label src expected)
+    (let ((r (forth-run src))) (forth-p2-assert label expected (nth r 2)))))
+
+(define
+  forth-p2-check-output
+  (fn
+    (label src expected)
+    (let ((r (forth-run src))) (forth-p2-assert label expected (nth r 1)))))
+
+(define
+  forth-p2-colon-tests
+  (fn
+    ()
+    (forth-p2-check-stack "simple colon" ": DOUBLE 2 * ; 7 DOUBLE" (list 14))
+    (forth-p2-check-stack "three-op body" ": ADD3 + + ; 1 2 3 ADD3" (list 6))
+    (forth-p2-check-stack
+      "nested call"
+      ": SQR DUP * ; : SOS SQR SWAP SQR + ; 3 4 SOS"
+      (list 25))
+    (forth-p2-check-stack
+      "deep chain"
+      ": D 2 ; : B D ; : A B D * ; A"
+      (list 4))
+    (forth-p2-check-stack
+      "colon uses literal"
+      ": FOO 1 2 + ; FOO FOO +"
+      (list 6))
+    (forth-p2-check-stack "case-insensitive def" ": BAR 9 ; bar" (list 9))
+    (forth-p2-check-stack
+      "redefinition picks newest"
+      ": F 1 ; : F 2 ; F"
+      (list 2))
+    (forth-p2-check-stack
+      "negative literal in def"
+      ": NEG5 -5 ; NEG5"
+      (list -5))
+    (forth-p2-check-stack "hex literal in def" ": X $10 ; X" (list 16))))
+
+(define
+  forth-p2-var-tests
+  (fn
+    ()
+    (forth-p2-check-stack "VARIABLE + !, @" "VARIABLE X 42 X ! X @" (list 42))
+    (forth-p2-check-stack "uninitialised @ is 0" "VARIABLE Y Y @" (list 0))
+    (forth-p2-check-stack
+      "two variables"
+      "VARIABLE A VARIABLE B 1 A ! 2 B ! A @ B @ +"
+      (list 3))
+    (forth-p2-check-stack
+      "+! increments"
+      "VARIABLE X 10 X ! 5 X +! X @"
+      (list 15))
+    (forth-p2-check-stack
+      "+! multiple"
+      "VARIABLE X 0 X ! 1 X +! 2 X +! 3 X +! X @"
+      (list 6))))
+
+(define
+  forth-p2-const-tests
+  (fn
+    ()
+    (forth-p2-check-stack "CONSTANT" "100 CONSTANT C C" (list 100))
+    (forth-p2-check-stack
+      "CONSTANT used twice"
+      "5 CONSTANT FIVE FIVE FIVE *"
+      (list 25))
+    (forth-p2-check-stack
+      "CONSTANT in colon"
+      "3 CONSTANT T : TRIPLE T * ; 7 TRIPLE"
+      (list 21))))
+
+(define
+  forth-p2-value-tests
+  (fn
+    ()
+    (forth-p2-check-stack "VALUE initial" "50 VALUE V V" (list 50))
+    (forth-p2-check-stack "TO overwrites" "50 VALUE V 99 TO V V" (list 99))
+    (forth-p2-check-stack "TO twice" "1 VALUE V 2 TO V 3 TO V V" (list 3))
+    (forth-p2-check-stack "VALUE in arithmetic" "7 VALUE V V 3 +" (list 10))))
+
+(define
+  forth-p2-io-tests
+  (fn
+    ()
+    (forth-p2-check-output
+      "colon prints"
+      ": HELLO 72 EMIT 73 EMIT ; HELLO"
+      "HI")
+    (forth-p2-check-output "colon CR" ": LINE 42 . CR ; LINE" "42 \n")))
+
+(define
+  forth-p2-mode-tests
+  (fn
+    ()
+    (forth-p2-check-stack "empty colon body" ": NOP ; 5 NOP" (list 5))
+    (forth-p2-check-stack
+      "colon using DUP"
+      ": TWICE DUP ; 9 TWICE"
+      (list 9 9))
+    (forth-p2-check-stack "IMMEDIATE NOP" ": X ; X" (list))))
+
+(define
+  forth-p2-run-all
+  (fn
+    ()
+    (set! forth-p2-passed 0)
+    (set! forth-p2-failed 0)
+    (set! forth-p2-failures (list))
+    (forth-p2-colon-tests)
+    (forth-p2-var-tests)
+    (forth-p2-const-tests)
+    (forth-p2-value-tests)
+    (forth-p2-io-tests)
+    (forth-p2-mode-tests)
+    (dict
+      "passed"
+      forth-p2-passed
+      "failed"
+      forth-p2-failed
+      "failures"
+      forth-p2-failures)))

lib/graphql-exec.sx

@@ -0,0 +1,219 @@
+
+;; GraphQL executor — walks parsed AST, dispatches via IO suspension
+;;
+;; Maps GraphQL operations to the defquery/defaction system:
+;;   query  → (perform (list 'io-gql-resolve "gql-query" field-name args))
+;;   mutation → (perform (list 'io-gql-resolve "gql-mutation" field-name args))
+;;
+;; Field selection projects results to only requested fields.
+;; Fragments are resolved by name lookup in the document.
+;; Variables are substituted from a provided bindings dict.
+;;
+;; Usage:
+;;   (gql-execute (gql-parse "{ posts { title } }"))
+;;   (gql-execute (gql-parse "query($id: ID!) { post(id: $id) { title } }") {:id 42})
+;;   (gql-execute ast variables resolver)  ;; custom resolver
+
+;; ── Variable substitution ─────────────────────────────────────────
+
+(define
+  gql-substitute-vars
+  (fn
+    (value vars)
+    "Recursively replace (gql-var name) nodes with values from vars dict."
+    (cond
+      ((not (list? value)) value)
+      ((= (first value) (quote gql-var))
+        (let
+          ((name (nth value 1)))
+          (let
+            ((kw (make-keyword name)))
+            (if
+              (has-key? vars kw)
+              (get vars kw)
+              (error (str "GraphQL: undefined variable $" name))))))
+      (true (map (fn (child) (gql-substitute-vars child vars)) value)))))
+
+;; ── Fragment collection ───────────────────────────────────────────
+
+(define
+  gql-collect-fragments
+  (fn
+    (doc)
+    "Build a dict of fragment-name → fragment-definition from a gql-doc."
+    (reduce
+      (fn
+        (acc def)
+        (if
+          (and (list? def) (= (first def) (quote gql-fragment)))
+          (assoc acc (make-keyword (nth def 1)) def)
+          acc))
+      {}
+      (rest doc))))
+
+;; ── Field selection (projection) ──────────────────────────────────
+
+(define
+  gql-project
+  (fn
+    (data selections fragments)
+    "Project a result dict/list down to only the requested fields."
+    (cond
+      ((nil? data) nil)
+      ((and (list? data) (not (dict? data)))
+        (map (fn (item) (gql-project item selections fragments)) data))
+      ((dict? data)
+        (if
+          (= (length selections) 0)
+          data
+          (reduce
+            (fn
+              (acc sel)
+              (cond
+                ((and (list? sel) (= (first sel) (quote gql-field)))
+                  (let
+                    ((name (nth sel 1))
+                      (sub-sels (nth sel 4))
+                      (alias (if (> (length sel) 5) (nth sel 5) nil))
+                      (out-key (make-keyword (if alias alias name))))
+                    (let
+                      ((field-val (get data (make-keyword name))))
+                      (if
+                        (> (length sub-sels) 0)
+                        (assoc
+                          acc
+                          out-key
+                          (gql-project field-val sub-sels fragments))
+                        (assoc acc out-key field-val)))))
+                ((and (list? sel) (= (first sel) (quote gql-fragment-spread)))
+                  (let
+                    ((frag-name (nth sel 1))
+                      (frag (get fragments (make-keyword frag-name))))
+                    (if
+                      frag
+                      (let
+                        ((frag-sels (nth frag 4)))
+                        (let
+                          ((projected (gql-project data frag-sels fragments)))
+                          (reduce
+                            (fn (a k) (assoc a k (get projected k)))
+                            acc
+                            (keys projected))))
+                      acc)))
+                ((and (list? sel) (= (first sel) (quote gql-inline-fragment)))
+                  (let
+                    ((sub-sels (nth sel 3)))
+                    (let
+                      ((projected (gql-project data sub-sels fragments)))
+                      (reduce
+                        (fn (a k) (assoc a k (get projected k)))
+                        acc
+                        (keys projected)))))
+                (true acc)))
+            {}
+            selections)))
+      (true data))))
+
+;; ── Default resolver ──────────────────────────────────────────────
+;; Dispatches root fields via IO suspension to the query/action registry.
+;; Platform provides io-gql-resolve handler.
+
+(define
+  gql-default-resolve
+  (fn
+    (field-name args op-type)
+    "Default resolver: dispatches via perform to the platform's IO handler."
+    (perform (list (quote io-gql-resolve) op-type field-name args))))
+
+;; ── Execute a single operation ────────────────────────────────────
+
+(define
+  gql-execute-operation
+  (fn
+    (op vars fragments resolve-fn)
+    "Execute one operation (query/mutation/subscription), return result dict."
+    (let
+      ((op-type (first op))
+        (selections (nth op 4))
+        (substituted (gql-substitute-vars selections vars)))
+      (let
+        ((result (reduce (fn (acc sel) (cond ((and (list? sel) (= (first sel) (quote gql-field))) (let ((name (nth sel 1)) (args-raw (nth sel 2)) (sub-sels (nth sel 4)) (alias (if (> (length sel) 5) (nth sel 5) nil)) (out-key (make-keyword (if alias alias name)))) (let ((args (map (fn (a) (list (first a) (gql-substitute-vars (nth a 1) vars))) args-raw))) (let ((args-dict (reduce (fn (d a) (assoc d (make-keyword (first a)) (nth a 1))) {} args))) (let ((raw (resolve-fn name args-dict op-type))) (if (> (length sub-sels) 0) (assoc acc out-key (gql-project raw sub-sels fragments)) (assoc acc out-key raw))))))) ((and (list? sel) (= (first sel) (quote gql-fragment-spread))) (let ((frag (get fragments (make-keyword (nth sel 1))))) (if frag (let ((merged (gql-execute-operation (list op-type nil (list) (list) (nth frag 4)) vars fragments resolve-fn))) (reduce (fn (a k) (assoc a k (get merged k))) acc (keys merged))) acc))) (true acc))) {} substituted)))
+        result))))
+
+;; ── Main entry point ──────────────────────────────────────────────
+
+(define
+  gql-execute
+  (fn
+    (doc &rest extra-args)
+    "Execute a parsed GraphQL document.\n     (gql-execute doc)\n     (gql-execute doc variables)\n     (gql-execute doc variables resolver-fn)\n     Returns {:data result} or {:data result :errors errors}."
+    (let
+      ((vars (if (> (length extra-args) 0) (first extra-args) {}))
+        (resolve-fn
+          (if
+            (> (length extra-args) 1)
+            (nth extra-args 1)
+            gql-default-resolve))
+        (fragments (gql-collect-fragments doc))
+        (definitions (rest doc)))
+      (let
+        ((ops (filter (fn (d) (and (list? d) (let ((t (first d))) (or (= t (quote gql-query)) (= t (quote gql-mutation)) (= t (quote gql-subscription)))))) definitions)))
+        (if
+          (= (length ops) 0)
+          {:errors (list "No operation found in document") :data nil}
+          (let
+            ((result (gql-execute-operation (first ops) vars fragments resolve-fn)))
+            {:data result}))))))
+
+;; ── Execute with named operation ──────────────────────────────────
+
+(define
+  gql-execute-named
+  (fn
+    (doc operation-name vars &rest extra-args)
+    "Execute a specific named operation from a multi-operation document."
+    (let
+      ((resolve-fn (if (> (length extra-args) 0) (first extra-args) gql-default-resolve))
+        (fragments (gql-collect-fragments doc))
+        (definitions (rest doc)))
+      (let
+        ((op (first (filter (fn (d) (and (list? d) (> (length d) 1) (= (nth d 1) operation-name))) definitions))))
+        (if
+          (nil? op)
+          {:errors (list (str "Operation '" operation-name "' not found")) :data nil}
+          (let
+            ((result (gql-execute-operation op vars fragments resolve-fn)))
+            {:data result}))))))
+
+;; ── Introspection helpers ─────────────────────────────────────────
+
+(define
+  gql-operation-names
+  (fn
+    (doc)
+    "List all operation names in a document."
+    (filter
+      (fn (x) (not (nil? x)))
+      (map
+        (fn (d) (if (and (list? d) (> (length d) 1)) (nth d 1) nil))
+        (filter
+          (fn
+            (d)
+            (and
+              (list? d)
+              (let
+                ((t (first d)))
+                (or
+                  (= t (quote gql-query))
+                  (= t (quote gql-mutation))
+                  (= t (quote gql-subscription))))))
+          (rest doc))))))
+
+(define
+  gql-extract-variables
+  (fn
+    (doc)
+    "Extract variable definitions from the first operation."
+    (let
+      ((ops (filter (fn (d) (and (list? d) (let ((t (first d))) (or (= t (quote gql-query)) (= t (quote gql-mutation)) (= t (quote gql-subscription)))))) (rest doc))))
+      (if (> (length ops) 0) (nth (first ops) 2) (list)))))

lib/graphql.sx

@@ -0,0 +1,686 @@
+
+;; GraphQL parser — tokenizer + recursive descent → SX AST
+;;
+;; Parses the GraphQL query language (queries, mutations, subscriptions,
+;; fragments, variables, directives) into s-expression AST.
+;;
+;; Usage:
+;;   (gql-parse "{ user(id: 1) { name email } }")
+;;
+;; AST node types:
+;;   (gql-doc definitions...)
+;;   (gql-query name vars directives selections)
+;;   (gql-mutation name vars directives selections)
+;;   (gql-subscription name vars directives selections)
+;;   (gql-field name args directives selections [alias])
+;;   (gql-fragment name on-type directives selections)
+;;   (gql-fragment-spread name directives)
+;;   (gql-inline-fragment on-type directives selections)
+;;   (gql-var name)                     — $variableName reference
+;;   (gql-var-def name type default)    — variable definition
+;;   (gql-type name)                    — named type
+;;   (gql-list-type inner)              — [Type]
+;;   (gql-non-null inner)               — Type!
+;;   (gql-directive name args)          — @directive(args)
+
+;; ── Character helpers (shared) ────────────────────────────────────
+
+(define
+  gql-ws?
+  (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r") (= c ","))))
+(define gql-digit? (fn (c) (and c (>= c "0") (<= c "9"))))
+(define
+  gql-letter?
+  (fn
+    (c)
+    (and c (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
+(define gql-name-start? (fn (c) (or (gql-letter? c) (= c "_"))))
+(define gql-name-char? (fn (c) (or (gql-name-start? c) (gql-digit? c))))
+
+;; ── Tokenizer ─────────────────────────────────────────────────────
+;; Returns {:tokens list :pos int} — state-passing style to avoid
+;; multiple define closures over the same mutable variable.
+
+(define
+  gql-char-at
+  (fn (src len i) (if (< i len) (substring src i (+ i 1)) nil)))
+
+(define
+  gql-skip-ws
+  (fn
+    (src len pos)
+    "Skip whitespace, commas, and # comments. Returns new pos."
+    (if
+      (>= pos len)
+      pos
+      (let
+        ((c (gql-char-at src len pos)))
+        (cond
+          ((gql-ws? c) (gql-skip-ws src len (+ pos 1)))
+          ((= c "#")
+            (let
+              ((eol-pos (gql-skip-to-eol src len (+ pos 1))))
+              (gql-skip-ws src len eol-pos)))
+          (true pos))))))
+
+(define
+  gql-skip-to-eol
+  (fn
+    (src len pos)
+    (if
+      (>= pos len)
+      pos
+      (if
+        (= (gql-char-at src len pos) "\n")
+        pos
+        (gql-skip-to-eol src len (+ pos 1))))))
+
+(define
+  gql-read-name
+  (fn
+    (src len pos)
+    "Read [_A-Za-z][_A-Za-z0-9]*. Returns {:value name :pos new-pos}."
+    (let
+      ((start pos))
+      (define
+        loop
+        (fn
+          (p)
+          (if
+            (and (< p len) (gql-name-char? (gql-char-at src len p)))
+            (loop (+ p 1))
+            {:pos p :value (substring src start p)})))
+      (loop pos))))
+
+(define
+  gql-read-number
+  (fn
+    (src len pos)
+    "Read number. Returns {:value num :pos new-pos}."
+    (let
+      ((start pos) (p pos))
+      (when (= (gql-char-at src len p) "-") (set! p (+ p 1)))
+      (define
+        dloop
+        (fn
+          (p has-dot)
+          (if
+            (>= p len)
+            {:pos p :value (parse-number (substring src start p))}
+            (let
+              ((c (gql-char-at src len p)))
+              (cond
+                ((gql-digit? c) (dloop (+ p 1) has-dot))
+                ((and (= c ".") (not has-dot)) (dloop (+ p 1) true))
+                ((or (= c "e") (= c "E"))
+                  (let
+                    ((p2 (+ p 1)))
+                    (when
+                      (or
+                        (= (gql-char-at src len p2) "+")
+                        (= (gql-char-at src len p2) "-"))
+                      (set! p2 (+ p2 1)))
+                    (dloop p2 has-dot)))
+                (true {:pos p :value (parse-number (substring src start p))}))))))
+      (dloop p false))))
+
+(define
+  gql-read-string
+  (fn
+    (src len pos)
+    "Read double-quoted string. pos is ON the opening quote. Returns {:value str :pos new-pos}."
+    (let
+      ((p (+ pos 1)))
+      (if
+        (and
+          (< (+ p 1) len)
+          (= (gql-char-at src len p) "\"")
+          (= (gql-char-at src len (+ p 1)) "\""))
+        (let
+          ((p2 (+ p 2)))
+          (define
+            bloop
+            (fn
+              (bp)
+              (if
+                (and
+                  (< (+ bp 2) len)
+                  (= (gql-char-at src len bp) "\"")
+                  (= (gql-char-at src len (+ bp 1)) "\"")
+                  (= (gql-char-at src len (+ bp 2)) "\""))
+                {:pos (+ bp 3) :value (substring src p2 bp)}
+                (bloop (+ bp 1)))))
+          (bloop p2))
+        (do
+          (define
+            sloop
+            (fn
+              (sp parts)
+              (if
+                (>= sp len)
+                {:pos sp :value (join "" parts)}
+                (let
+                  ((c (gql-char-at src len sp)))
+                  (cond
+                    ((= c "\"") {:pos (+ sp 1) :value (join "" parts)})
+                    ((= c "\\")
+                      (let
+                        ((esc (gql-char-at src len (+ sp 1)))
+                          (sp2 (+ sp 2)))
+                        (sloop
+                          sp2
+                          (append
+                            parts
+                            (list
+                              (cond
+                                ((= esc "n") "\n")
+                                ((= esc "t") "\t")
+                                ((= esc "r") "\r")
+                                ((= esc "\\") "\\")
+                                ((= esc "\"") "\"")
+                                ((= esc "/") "/")
+                                (true (str "\\" esc))))))))
+                    (true (sloop (+ sp 1) (append parts (list c)))))))))
+          (sloop p (list)))))))
+
+(define
+  gql-tokenize
+  (fn
+    (src)
+    (let
+      ((len (string-length src)))
+      (define
+        tok-loop
+        (fn
+          (pos acc)
+          (let
+            ((pos (gql-skip-ws src len pos)))
+            (if
+              (>= pos len)
+              (append acc (list {:pos pos :value nil :type "eof"}))
+              (let
+                ((c (gql-char-at src len pos)))
+                (cond
+                  ((= c "{")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "{" :type "brace-open"}))))
+                  ((= c "}")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "}" :type "brace-close"}))))
+                  ((= c "(")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "(" :type "paren-open"}))))
+                  ((= c ")")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value ")" :type "paren-close"}))))
+                  ((= c "[")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "[" :type "bracket-open"}))))
+                  ((= c "]")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "]" :type "bracket-close"}))))
+                  ((= c ":")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value ":" :type "colon"}))))
+                  ((= c "!")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "!" :type "bang"}))))
+                  ((= c "$")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "$" :type "dollar"}))))
+                  ((= c "@")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "@" :type "at"}))))
+                  ((= c "=")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "=" :type "equals"}))))
+                  ((= c "|")
+                    (tok-loop (+ pos 1) (append acc (list {:pos pos :value "|" :type "pipe"}))))
+                  ((and (= c ".") (< (+ pos 2) len) (= (gql-char-at src len (+ pos 1)) ".") (= (gql-char-at src len (+ pos 2)) "."))
+                    (tok-loop (+ pos 3) (append acc (list {:pos pos :value "..." :type "spread"}))))
+                  ((= c "\"")
+                    (let
+                      ((r (gql-read-string src len pos)))
+                      (tok-loop (get r :pos) (append acc (list {:pos pos :value (get r :value) :type "string"})))))
+                  ((or (gql-digit? c) (and (= c "-") (< (+ pos 1) len) (gql-digit? (gql-char-at src len (+ pos 1)))))
+                    (let
+                      ((r (gql-read-number src len pos)))
+                      (tok-loop (get r :pos) (append acc (list {:pos pos :value (get r :value) :type "number"})))))
+                  ((gql-name-start? c)
+                    (let
+                      ((r (gql-read-name src len pos)))
+                      (tok-loop (get r :pos) (append acc (list {:pos pos :value (get r :value) :type "name"})))))
+                  (true (tok-loop (+ pos 1) acc))))))))
+      (tok-loop 0 (list)))))
+
+;; ── Parser ────────────────────────────────────────────────────────
+
+(define
+  gql-parse-tokens
+  (fn
+    (tokens)
+    (let
+      ((p 0) (tlen (length tokens)))
+      (define cur (fn () (if (< p tlen) (nth tokens p) {:value nil :type "eof"})))
+      (define cur-type (fn () (get (cur) :type)))
+      (define cur-val (fn () (get (cur) :value)))
+      (define adv! (fn () (set! p (+ p 1))))
+      (define at-end? (fn () (= (cur-type) "eof")))
+      (define
+        expect!
+        (fn
+          (type)
+          (if
+            (= (cur-type) type)
+            (let ((v (cur-val))) (adv!) v)
+            (error
+              (str "GraphQL parse error: expected " type " got " (cur-type))))))
+      (define expect-name! (fn () (expect! "name")))
+      (define
+        parse-value
+        (fn
+          ()
+          (let
+            ((typ (cur-type)) (val (cur-val)))
+            (cond
+              ((= typ "dollar")
+                (do (adv!) (list (quote gql-var) (expect-name!))))
+              ((= typ "number") (do (adv!) val))
+              ((= typ "string") (do (adv!) val))
+              ((and (= typ "name") (= val "true")) (do (adv!) true))
+              ((and (= typ "name") (= val "false")) (do (adv!) false))
+              ((and (= typ "name") (= val "null")) (do (adv!) nil))
+              ((= typ "bracket-open") (parse-list-value))
+              ((= typ "brace-open") (parse-object-value))
+              ((= typ "name") (do (adv!) val))
+              (true
+                (error
+                  (str "GraphQL parse error: unexpected " typ " in value")))))))
+      (define
+        parse-list-value
+        (fn
+          ()
+          (do
+            (expect! "bracket-open")
+            (define
+              collect
+              (fn
+                (acc)
+                (if
+                  (or (at-end?) (= (cur-type) "bracket-close"))
+                  (do (expect! "bracket-close") acc)
+                  (collect (append acc (list (parse-value)))))))
+            (collect (list)))))
+      (define
+        parse-object-value
+        (fn
+          ()
+          (do
+            (expect! "brace-open")
+            (define
+              collect
+              (fn
+                (acc)
+                (if
+                  (or (at-end?) (= (cur-type) "brace-close"))
+                  (do (expect! "brace-close") acc)
+                  (let
+                    ((k (expect-name!)))
+                    (expect! "colon")
+                    (let
+                      ((v (parse-value)))
+                      (collect (assoc acc (make-keyword k) v)))))))
+            (collect {}))))
+      (define
+        parse-arguments
+        (fn
+          ()
+          (if
+            (not (= (cur-type) "paren-open"))
+            (list)
+            (do
+              (adv!)
+              (define
+                collect
+                (fn
+                  (acc)
+                  (if
+                    (or (at-end?) (= (cur-type) "paren-close"))
+                    (do (adv!) acc)
+                    (let
+                      ((name (expect-name!)))
+                      (expect! "colon")
+                      (let
+                        ((val (parse-value)))
+                        (collect (append acc (list (list name val)))))))))
+              (collect (list))))))
+      (define
+        parse-directives
+        (fn
+          ()
+          (define
+            collect
+            (fn
+              (acc)
+              (if
+                (and (= (cur-type) "at") (not (at-end?)))
+                (do
+                  (adv!)
+                  (let
+                    ((name (expect-name!)) (args (parse-arguments)))
+                    (collect
+                      (append
+                        acc
+                        (list (list (quote gql-directive) name args))))))
+                acc)))
+          (collect (list))))
+      (define
+        parse-type
+        (fn
+          ()
+          (let
+            ((base (cond ((= (cur-type) "bracket-open") (do (adv!) (let ((inner (parse-type))) (expect! "bracket-close") (list (quote gql-list-type) inner)))) (true (list (quote gql-type) (expect-name!))))))
+            (if
+              (= (cur-type) "bang")
+              (do (adv!) (list (quote gql-non-null) base))
+              base))))
+      (define
+        parse-variable-defs
+        (fn
+          ()
+          (if
+            (not (= (cur-type) "paren-open"))
+            (list)
+            (do
+              (adv!)
+              (define
+                collect
+                (fn
+                  (acc)
+                  (if
+                    (or (at-end?) (= (cur-type) "paren-close"))
+                    (do (adv!) acc)
+                    (do
+                      (expect! "dollar")
+                      (let
+                        ((name (expect-name!)))
+                        (expect! "colon")
+                        (let
+                          ((typ (parse-type))
+                            (default
+                              (if
+                                (= (cur-type) "equals")
+                                (do (adv!) (parse-value))
+                                nil)))
+                          (collect
+                            (append
+                              acc
+                              (list
+                                (list (quote gql-var-def) name typ default))))))))))
+              (collect (list))))))
+      (define
+        parse-selection-set
+        (fn
+          ()
+          (if
+            (not (= (cur-type) "brace-open"))
+            (list)
+            (do
+              (adv!)
+              (define
+                collect
+                (fn
+                  (acc)
+                  (if
+                    (or (at-end?) (= (cur-type) "brace-close"))
+                    (do (adv!) acc)
+                    (collect (append acc (list (parse-selection)))))))
+              (collect (list))))))
+      (define
+        parse-selection
+        (fn
+          ()
+          (cond
+            ((= (cur-type) "spread")
+              (do
+                (adv!)
+                (if
+                  (and (= (cur-type) "name") (not (= (cur-val) "on")))
+                  (let
+                    ((name (expect-name!)) (dirs (parse-directives)))
+                    (list (quote gql-fragment-spread) name dirs))
+                  (let
+                    ((on-type (if (and (= (cur-type) "name") (= (cur-val) "on")) (do (adv!) (expect-name!)) nil))
+                      (dirs (parse-directives))
+                      (sels (parse-selection-set)))
+                    (list (quote gql-inline-fragment) on-type dirs sels)))))
+            (true (parse-field)))))
+      (define
+        parse-field
+        (fn
+          ()
+          (let
+            ((name1 (expect-name!)))
+            (let
+              ((actual-name (if (= (cur-type) "colon") (do (adv!) (expect-name!)) nil))
+                (alias (if actual-name name1 nil))
+                (field-name (if actual-name actual-name name1)))
+              (let
+                ((args (parse-arguments))
+                  (dirs (parse-directives))
+                  (sels (parse-selection-set)))
+                (if
+                  alias
+                  (list (quote gql-field) field-name args dirs sels alias)
+                  (list (quote gql-field) field-name args dirs sels)))))))
+      (define
+        parse-operation
+        (fn
+          (op-type)
+          (let
+            ((name (if (and (= (cur-type) "name") (not (= (cur-val) "query")) (not (= (cur-val) "mutation")) (not (= (cur-val) "subscription")) (not (= (cur-val) "fragment"))) (expect-name!) nil))
+              (vars (parse-variable-defs))
+              (dirs (parse-directives))
+              (sels (parse-selection-set)))
+            (list op-type name vars dirs sels))))
+      (define
+        parse-fragment-def
+        (fn
+          ()
+          (let
+            ((name (expect-name!)))
+            (when (and (= (cur-type) "name") (= (cur-val) "on")) (adv!))
+            (let
+              ((on-type (expect-name!))
+                (dirs (parse-directives))
+                (sels (parse-selection-set)))
+              (list (quote gql-fragment) name on-type dirs sels)))))
+      (define
+        parse-definition
+        (fn
+          ()
+          (let
+            ((typ (cur-type)) (val (cur-val)))
+            (cond
+              ((= typ "brace-open")
+                (let
+                  ((sels (parse-selection-set)))
+                  (list (quote gql-query) nil (list) (list) sels)))
+              ((and (= typ "name") (= val "query"))
+                (do (adv!) (parse-operation (quote gql-query))))
+              ((and (= typ "name") (= val "mutation"))
+                (do (adv!) (parse-operation (quote gql-mutation))))
+              ((and (= typ "name") (= val "subscription"))
+                (do (adv!) (parse-operation (quote gql-subscription))))
+              ((and (= typ "name") (= val "fragment"))
+                (do (adv!) (parse-fragment-def)))
+              (true
+                (error
+                  (str
+                    "GraphQL parse error: unexpected "
+                    typ
+                    " "
+                    (if val val ""))))))))
+      (define
+        parse-document
+        (fn
+          ()
+          (define
+            collect
+            (fn
+              (acc)
+              (if
+                (at-end?)
+                (cons (quote gql-doc) acc)
+                (collect (append acc (list (parse-definition)))))))
+          (collect (list))))
+      (parse-document))))
+
+;; ── Convenience: source → AST ─────────────────────────────────────
+
+(define gql-parse (fn (source) (gql-parse-tokens (gql-tokenize source))))
+
+;; ── AST accessors ─────────────────────────────────────────────────
+
+(define gql-node-type (fn (node) (if (list? node) (first node) nil)))
+(define gql-doc? (fn (node) (= (gql-node-type node) (quote gql-doc))))
+(define gql-query? (fn (node) (= (gql-node-type node) (quote gql-query))))
+(define
+  gql-mutation?
+  (fn (node) (= (gql-node-type node) (quote gql-mutation))))
+(define
+  gql-subscription?
+  (fn (node) (= (gql-node-type node) (quote gql-subscription))))
+(define gql-field? (fn (node) (= (gql-node-type node) (quote gql-field))))
+(define
+  gql-fragment?
+  (fn (node) (= (gql-node-type node) (quote gql-fragment))))
+(define
+  gql-fragment-spread?
+  (fn (node) (= (gql-node-type node) (quote gql-fragment-spread))))
+(define gql-var? (fn (node) (= (gql-node-type node) (quote gql-var))))
+
+;; Field accessors: (gql-field name args directives selections [alias])
+(define gql-field-name (fn (f) (nth f 1)))
+(define gql-field-args (fn (f) (nth f 2)))
+(define gql-field-directives (fn (f) (nth f 3)))
+(define gql-field-selections (fn (f) (nth f 4)))
+(define gql-field-alias (fn (f) (if (> (length f) 5) (nth f 5) nil)))
+
+;; Operation accessors: (gql-query/mutation/subscription name vars directives selections)
+(define gql-op-name (fn (op) (nth op 1)))
+(define gql-op-vars (fn (op) (nth op 2)))
+(define gql-op-directives (fn (op) (nth op 3)))
+(define gql-op-selections (fn (op) (nth op 4)))
+
+;; Fragment accessors: (gql-fragment name on-type directives selections)
+(define gql-frag-name (fn (f) (nth f 1)))
+(define gql-frag-type (fn (f) (nth f 2)))
+(define gql-frag-directives (fn (f) (nth f 3)))
+(define gql-frag-selections (fn (f) (nth f 4)))
+
+;; Document: (gql-doc def1 def2 ...)
+(define gql-doc-definitions (fn (doc) (rest doc)))
+
+;; ── Serializer: AST → GraphQL source ─────────────────────────────
+
+(define
+  serialize-selection-set
+  (fn (sels) (str "{ " (join " " (map gql-serialize sels)) " }")))
+
+(define
+  serialize-args
+  (fn
+    (args)
+    (str
+      "("
+      (join
+        ", "
+        (map
+          (fn (a) (str (first a) ": " (gql-serialize (nth a 1))))
+          args))
+      ")")))
+
+(define
+  serialize-var-defs
+  (fn
+    (vars)
+    (str
+      "("
+      (join
+        ", "
+        (map
+          (fn
+            (v)
+            (let
+              ((name (nth v 1))
+                (typ (serialize-type (nth v 2)))
+                (default (nth v 3)))
+              (str
+                "$"
+                name
+                ": "
+                typ
+                (if default (str " = " (gql-serialize default)) ""))))
+          vars))
+      ")")))
+
+(define
+  serialize-type
+  (fn
+    (t)
+    (let
+      ((typ (first t)))
+      (cond
+        ((= typ (quote gql-type)) (nth t 1))
+        ((= typ (quote gql-list-type))
+          (str "[" (serialize-type (nth t 1)) "]"))
+        ((= typ (quote gql-non-null))
+          (str (serialize-type (nth t 1)) "!"))
+        (true "Unknown")))))
+
+(define
+  gql-serialize
+  (fn
+    (node)
+    (cond
+      ((not (list? node))
+        (cond
+          ((string? node) (str "\"" node "\""))
+          ((number? node) (str node))
+          ((= node true) "true")
+          ((= node false) "false")
+          ((nil? node) "null")
+          (true (str node))))
+      (true
+        (let
+          ((typ (gql-node-type node)))
+          (cond
+            ((= typ (quote gql-doc))
+              (join "\n\n" (map gql-serialize (gql-doc-definitions node))))
+            ((or (= typ (quote gql-query)) (= typ (quote gql-mutation)) (= typ (quote gql-subscription)))
+              (let
+                ((op-word (cond ((= typ (quote gql-query)) "query") ((= typ (quote gql-mutation)) "mutation") ((= typ (quote gql-subscription)) "subscription")))
+                  (name (gql-op-name node))
+                  (vars (gql-op-vars node))
+                  (sels (gql-op-selections node)))
+                (str
+                  op-word
+                  (if name (str " " name) "")
+                  (if (> (length vars) 0) (serialize-var-defs vars) "")
+                  " "
+                  (serialize-selection-set sels))))
+            ((= typ (quote gql-field))
+              (let
+                ((name (gql-field-name node))
+                  (alias (gql-field-alias node))
+                  (args (gql-field-args node))
+                  (sels (gql-field-selections node)))
+                (str
+                  (if alias (str alias ": ") "")
+                  name
+                  (if (> (length args) 0) (serialize-args args) "")
+                  (if
+                    (> (length sels) 0)
+                    (str " " (serialize-selection-set sels))
+                    ""))))
+            ((= typ (quote gql-fragment))
+              (str
+                "fragment "
+                (gql-frag-name node)
+                " on "
+                (gql-frag-type node)
+                " "
+                (serialize-selection-set (gql-frag-selections node))))
+            ((= typ (quote gql-fragment-spread)) (str "..." (nth node 1)))
+            ((= typ (quote gql-var)) (str "$" (nth node 1)))
+            (true "")))))))

lib/haskell/desugar.sx

@@ -0,0 +1,249 @@
+;; Desugar the Haskell surface AST into a smaller core AST.
+;;
+;; Eliminates the three surface-only shapes produced by the parser:
+;;   :where BODY DECLS     →  :let DECLS BODY
+;;   :guarded GUARDS       →  :if C1 E1 (:if C2 E2 … (:app error …))
+;;   :list-comp EXPR QUALS →  concatMap-based expression (§3.11)
+;;
+;; Everything else (:app, :op, :lambda, :let, :case, :do, :tuple,
+;; :list, :range, :if, :neg, :sect-left / :sect-right, plus all
+;; leaf forms and pattern / type nodes) is passed through after
+;; recursing into children.
+
+(define
+  hk-guards-to-if
+  (fn
+    (guards)
+    (cond
+      ((empty? guards)
+        (list
+          :app
+          (list :var "error")
+          (list :string "Non-exhaustive guards")))
+      (:else
+        (let
+          ((g (first guards)))
+          (list
+            :if
+            (hk-desugar (nth g 1))
+            (hk-desugar (nth g 2))
+            (hk-guards-to-if (rest guards))))))))
+
+;; do-notation desugaring (Haskell 98 §3.14):
+;;   do { e }              =  e
+;;   do { e ; ss }         =  e >> do { ss }
+;;   do { p <- e ; ss }    =  e >>= \p -> do { ss }
+;;   do { let decls ; ss } =  let decls in do { ss }
+(define
+  hk-desugar-do
+  (fn
+    (stmts)
+    (cond
+      ((empty? stmts) (raise "empty do block"))
+      ((empty? (rest stmts))
+        (let ((s (first stmts)))
+          (cond
+            ((= (first s) "do-expr") (hk-desugar (nth s 1)))
+            (:else
+              (raise "do block must end with an expression")))))
+      (:else
+        (let
+          ((s (first stmts)) (rest-stmts (rest stmts)))
+          (let
+            ((rest-do (hk-desugar-do rest-stmts)))
+            (cond
+              ((= (first s) "do-expr")
+                (list
+                  :app
+                  (list
+                    :app
+                    (list :var ">>")
+                    (hk-desugar (nth s 1)))
+                  rest-do))
+              ((= (first s) "do-bind")
+                (list
+                  :app
+                  (list
+                    :app
+                    (list :var ">>=")
+                    (hk-desugar (nth s 2)))
+                  (list :lambda (list (nth s 1)) rest-do)))
+              ((= (first s) "do-let")
+                (list
+                  :let
+                  (map hk-desugar (nth s 1))
+                  rest-do))
+              (:else (raise "unknown do-stmt tag")))))))))
+
+;; List-comprehension desugaring (Haskell 98 §3.11):
+;;   [e |             ]  =  [e]
+;;   [e | b,     Q    ]  =  if b then [e | Q] else []
+;;   [e | p <- l, Q    ]  =  concatMap (\p -> [e | Q]) l
+;;   [e | let ds, Q    ]  =  let ds in [e | Q]
+(define
+  hk-lc-desugar
+  (fn
+    (e quals)
+    (cond
+      ((empty? quals) (list :list (list e)))
+      (:else
+        (let
+          ((q (first quals)))
+          (let
+            ((qtag (first q)))
+            (cond
+              ((= qtag "q-guard")
+                (list
+                  :if
+                  (hk-desugar (nth q 1))
+                  (hk-lc-desugar e (rest quals))
+                  (list :list (list))))
+              ((= qtag "q-gen")
+                (list
+                  :app
+                  (list
+                    :app
+                    (list :var "concatMap")
+                    (list
+                      :lambda
+                      (list (nth q 1))
+                      (hk-lc-desugar e (rest quals))))
+                  (hk-desugar (nth q 2))))
+              ((= qtag "q-let")
+                (list
+                  :let
+                  (map hk-desugar (nth q 1))
+                  (hk-lc-desugar e (rest quals))))
+              (:else
+                (raise
+                  (str
+                    "hk-lc-desugar: unknown qualifier tag "
+                    qtag))))))))))
+
+(define
+  hk-desugar
+  (fn
+    (node)
+    (cond
+      ((not (list? node)) node)
+      ((empty? node) node)
+      (:else
+        (let
+          ((tag (first node)))
+          (cond
+            ;; Transformations
+            ((= tag "where")
+              (list
+                :let
+                (map hk-desugar (nth node 2))
+                (hk-desugar (nth node 1))))
+            ((= tag "guarded") (hk-guards-to-if (nth node 1)))
+            ((= tag "list-comp")
+              (hk-lc-desugar
+                (hk-desugar (nth node 1))
+                (nth node 2)))
+
+            ;; Expression nodes
+            ((= tag "app")
+              (list
+                :app
+                (hk-desugar (nth node 1))
+                (hk-desugar (nth node 2))))
+            ((= tag "op")
+              (list
+                :op
+                (nth node 1)
+                (hk-desugar (nth node 2))
+                (hk-desugar (nth node 3))))
+            ((= tag "neg") (list :neg (hk-desugar (nth node 1))))
+            ((= tag "if")
+              (list
+                :if
+                (hk-desugar (nth node 1))
+                (hk-desugar (nth node 2))
+                (hk-desugar (nth node 3))))
+            ((= tag "tuple")
+              (list :tuple (map hk-desugar (nth node 1))))
+            ((= tag "list")
+              (list :list (map hk-desugar (nth node 1))))
+            ((= tag "range")
+              (list
+                :range
+                (hk-desugar (nth node 1))
+                (hk-desugar (nth node 2))))
+            ((= tag "range-step")
+              (list
+                :range-step
+                (hk-desugar (nth node 1))
+                (hk-desugar (nth node 2))
+                (hk-desugar (nth node 3))))
+            ((= tag "lambda")
+              (list
+                :lambda
+                (nth node 1)
+                (hk-desugar (nth node 2))))
+            ((= tag "let")
+              (list
+                :let
+                (map hk-desugar (nth node 1))
+                (hk-desugar (nth node 2))))
+            ((= tag "case")
+              (list
+                :case
+                (hk-desugar (nth node 1))
+                (map hk-desugar (nth node 2))))
+            ((= tag "alt")
+              (list :alt (nth node 1) (hk-desugar (nth node 2))))
+            ((= tag "do") (hk-desugar-do (nth node 1)))
+            ((= tag "sect-left")
+              (list
+                :sect-left
+                (nth node 1)
+                (hk-desugar (nth node 2))))
+            ((= tag "sect-right")
+              (list
+                :sect-right
+                (nth node 1)
+                (hk-desugar (nth node 2))))
+
+            ;; Top-level
+            ((= tag "program")
+              (list :program (map hk-desugar (nth node 1))))
+            ((= tag "module")
+              (list
+                :module
+                (nth node 1)
+                (nth node 2)
+                (nth node 3)
+                (map hk-desugar (nth node 4))))
+
+            ;; Decls carrying a body
+            ((= tag "fun-clause")
+              (list
+                :fun-clause
+                (nth node 1)
+                (nth node 2)
+                (hk-desugar (nth node 3))))
+            ((= tag "pat-bind")
+              (list
+                :pat-bind
+                (nth node 1)
+                (hk-desugar (nth node 2))))
+            ((= tag "bind")
+              (list
+                :bind
+                (nth node 1)
+                (hk-desugar (nth node 2))))
+
+            ;; Everything else: leaf literals, vars, cons, patterns,
+            ;; types, imports, type-sigs, data / newtype / fixity, …
+            (:else node)))))))
+
+;; Convenience — tokenize + layout + parse + desugar.
+(define
+  hk-core
+  (fn (src) (hk-desugar (hk-parse-top src))))
+
+(define
+  hk-core-expr
+  (fn (src) (hk-desugar (hk-parse src))))

lib/haskell/eval.sx

@@ -0,0 +1,775 @@
+;; Haskell strict evaluator (Phase 2).
+;;
+;; Consumes the post-desugar core AST and produces SX values. Strict
+;; throughout — laziness and thunks are Phase 3.
+;;
+;; Value representation:
+;;   numbers / strings / chars      → raw SX values
+;;   constructor values             → tagged lists (con-name first)
+;;   functions: closure / multifun  → {:type "fn" :kind … …}
+;;   constructor partials           → {:type "con-partial" …}
+;;   built-ins                      → {:type "builtin" …}
+;;
+;; Multi-clause top-level definitions are bundled into a single
+;; multifun keyed by name; arguments are gathered through currying
+;; until arity is reached, then each clause's pattern list is matched
+;; in order. Recursive let bindings work because the binding env is
+;; built mutably so closures captured during evaluation see the
+;; eventual full env.
+
+(define
+  hk-dict-copy
+  (fn
+    (d)
+    (let ((nd (dict)))
+      (for-each
+        (fn (k) (dict-set! nd k (get d k)))
+        (keys d))
+      nd)))
+
+;; ── Thunks (Phase 3 — laziness) ─────────────────────────────
+;; A thunk wraps an unevaluated AST plus the env in which it was
+;; created. The first call to `hk-force` evaluates the body, replaces
+;; the body with the cached value, and flips `forced`. Subsequent
+;; forces return the cached value directly.
+(define
+  hk-mk-thunk
+  (fn
+    (body env)
+    {:type "thunk" :body body :env env :forced false :value nil}))
+
+(define
+  hk-is-thunk?
+  (fn (v) (and (dict? v) (= (get v "type") "thunk"))))
+
+(define
+  hk-force
+  (fn
+    (v)
+    (cond
+      ((hk-is-thunk? v)
+        (cond
+          ((get v "forced") (get v "value"))
+          (:else
+            (let
+              ((res (hk-force (hk-eval (get v "body") (get v "env")))))
+              (dict-set! v "forced" true)
+              (dict-set! v "value" res)
+              res))))
+      (:else v))))
+
+;; Recursive force — used at the test/output boundary so test
+;; expectations can compare against fully-evaluated structures.
+(define
+  hk-deep-force
+  (fn
+    (v)
+    (let ((fv (hk-force v)))
+      (cond
+        ((not (list? fv)) fv)
+        ((empty? fv) fv)
+        (:else (map hk-deep-force fv))))))
+
+;; ── Function value constructors ──────────────────────────────
+(define
+  hk-mk-closure
+  (fn
+    (params body env)
+    {:type "fn" :kind "closure" :params params :body body :env env}))
+
+(define
+  hk-mk-multifun
+  (fn
+    (arity clauses env)
+    {:type "fn" :kind "multi" :arity arity :clauses clauses :env env :collected (list)}))
+
+(define
+  hk-mk-builtin
+  (fn
+    (name fn arity)
+    {:type "builtin" :name name :fn fn :arity arity :lazy false :collected (list)}))
+
+;; A lazy built-in receives its collected args as raw thunks (or
+;; values, if those happened to be eager) — the implementation is
+;; responsible for forcing exactly what it needs. Used for `seq`
+;; and `deepseq`, which are non-strict in their second argument.
+(define
+  hk-mk-lazy-builtin
+  (fn
+    (name fn arity)
+    {:type "builtin" :name name :fn fn :arity arity :lazy true :collected (list)}))
+
+;; ── Apply a function value to one argument ──────────────────
+(define
+  hk-apply
+  (fn
+    (f arg)
+    (let ((f (hk-force f)))
+      (cond
+        ((not (dict? f))
+          (raise (str "apply: not a function value: " f)))
+        ((= (get f "type") "fn")
+          (cond
+            ((= (get f "kind") "closure") (hk-apply-closure f arg))
+            ((= (get f "kind") "multi") (hk-apply-multi f arg))
+            (:else (raise "apply: unknown fn kind"))))
+        ((= (get f "type") "con-partial") (hk-apply-con-partial f arg))
+        ((= (get f "type") "builtin") (hk-apply-builtin f arg))
+        (:else (raise "apply: not a function dict"))))))
+
+(define
+  hk-apply-closure
+  (fn
+    (cl arg)
+    (let
+      ((params (get cl "params"))
+        (body (get cl "body"))
+        (env (get cl "env")))
+      (cond
+        ((empty? params) (raise "apply-closure: no params"))
+        (:else
+          (let
+            ((p1 (first params)) (rest-p (rest params)))
+            (let
+              ((env-after (hk-match p1 arg env)))
+              (cond
+                ((nil? env-after)
+                  (raise "pattern match failure in lambda"))
+                ((empty? rest-p) (hk-eval body env-after))
+                (:else
+                  (hk-mk-closure rest-p body env-after))))))))))
+
+(define
+  hk-apply-multi
+  (fn
+    (mf arg)
+    (let
+      ((arity (get mf "arity"))
+        (clauses (get mf "clauses"))
+        (env (get mf "env"))
+        (collected (append (get mf "collected") (list arg))))
+      (cond
+        ((< (len collected) arity)
+          (assoc mf "collected" collected))
+        (:else (hk-dispatch-multi clauses collected env))))))
+
+(define
+  hk-dispatch-multi
+  (fn
+    (clauses args env)
+    (cond
+      ((empty? clauses)
+        (raise "non-exhaustive patterns in function definition"))
+      (:else
+        (let
+          ((c (first clauses)))
+          (let
+            ((pats (first c)) (body (first (rest c))))
+            (let
+              ((env-after (hk-match-args pats args env)))
+              (cond
+                ((nil? env-after)
+                  (hk-dispatch-multi (rest clauses) args env))
+                (:else (hk-eval body env-after))))))))))
+
+(define
+  hk-match-args
+  (fn
+    (pats args env)
+    (cond
+      ((empty? pats) env)
+      (:else
+        (let
+          ((res (hk-match (first pats) (first args) env)))
+          (cond
+            ((nil? res) nil)
+            (:else
+              (hk-match-args (rest pats) (rest args) res))))))))
+
+(define
+  hk-apply-con-partial
+  (fn
+    (cp arg)
+    (let
+      ((name (get cp "name"))
+        (arity (get cp "arity"))
+        (args (append (get cp "args") (list arg))))
+      (cond
+        ((= (len args) arity) (hk-mk-con name args))
+        (:else (assoc cp "args" args))))))
+
+(define
+  hk-apply-builtin
+  (fn
+    (b arg)
+    (let
+      ((arity (get b "arity"))
+        (collected (append (get b "collected") (list arg))))
+      (cond
+        ((< (len collected) arity)
+          (assoc b "collected" collected))
+        (:else
+          ;; Strict built-ins force every collected arg before
+          ;; calling. Lazy ones (`seq`, `deepseq`) receive the raw
+          ;; thunks so they can choose what to force.
+          (cond
+            ((get b "lazy") (apply (get b "fn") collected))
+            (:else
+              (apply
+                (get b "fn")
+                (map hk-force collected)))))))))
+
+;; ── Bool helpers (Bool values are tagged conses) ────────────
+(define
+  hk-truthy?
+  (fn
+    (v)
+    (and (list? v) (not (empty? v)) (= (first v) "True"))))
+
+(define hk-true (hk-mk-con "True" (list)))
+(define hk-false (hk-mk-con "False" (list)))
+(define hk-of-bool (fn (b) (if b hk-true hk-false)))
+
+;; ── Core eval ───────────────────────────────────────────────
+(define
+  hk-eval
+  (fn
+    (node env)
+    (cond
+      ((not (list? node)) (raise (str "eval: not a list: " node)))
+      ((empty? node) (raise "eval: empty list node"))
+      (:else
+        (let
+          ((tag (first node)))
+          (cond
+            ((= tag "int") (nth node 1))
+            ((= tag "float") (nth node 1))
+            ((= tag "string") (nth node 1))
+            ((= tag "char") (nth node 1))
+            ((= tag "var") (hk-eval-var (nth node 1) env))
+            ((= tag "con") (hk-eval-con-ref (nth node 1)))
+            ((= tag "neg")
+              (- 0 (hk-force (hk-eval (nth node 1) env))))
+            ((= tag "if") (hk-eval-if node env))
+            ((= tag "let") (hk-eval-let (nth node 1) (nth node 2) env))
+            ((= tag "lambda")
+              (hk-mk-closure (nth node 1) (nth node 2) env))
+            ((= tag "app")
+              (hk-apply
+                (hk-eval (nth node 1) env)
+                (hk-mk-thunk (nth node 2) env)))
+            ((= tag "op")
+              (hk-eval-op
+                (nth node 1)
+                (nth node 2)
+                (nth node 3)
+                env))
+            ((= tag "case")
+              (hk-eval-case (nth node 1) (nth node 2) env))
+            ((= tag "tuple")
+              (hk-mk-tuple
+                (map (fn (e) (hk-eval e env)) (nth node 1))))
+            ((= tag "list")
+              (hk-mk-list
+                (map (fn (e) (hk-eval e env)) (nth node 1))))
+            ((= tag "range")
+              (let
+                ((from (hk-force (hk-eval (nth node 1) env)))
+                  (to (hk-force (hk-eval (nth node 2) env))))
+                (hk-build-range from to 1)))
+            ((= tag "range-step")
+              (let
+                ((from (hk-force (hk-eval (nth node 1) env)))
+                  (nxt (hk-force (hk-eval (nth node 2) env)))
+                  (to (hk-force (hk-eval (nth node 3) env))))
+                (hk-build-range from to (- nxt from))))
+            ((= tag "range-from")
+              ;; [from..] = iterate (+ 1) from — uses the Prelude.
+              (hk-eval
+                (list
+                  :app
+                  (list
+                    :app
+                    (list :var "iterate")
+                    (list
+                      :sect-right
+                      "+"
+                      (list :int 1)))
+                  (nth node 1))
+                env))
+            ((= tag "sect-left")
+              (hk-eval-sect-left (nth node 1) (nth node 2) env))
+            ((= tag "sect-right")
+              (hk-eval-sect-right (nth node 1) (nth node 2) env))
+            (:else
+              (raise (str "eval: unknown node tag '" tag "'")))))))))
+
+(define
+  hk-eval-var
+  (fn
+    (name env)
+    (cond
+      ((has-key? env name) (get env name))
+      ((hk-is-con? name) (hk-eval-con-ref name))
+      (:else (raise (str "unbound variable: " name))))))
+
+(define
+  hk-eval-con-ref
+  (fn
+    (name)
+    (let ((arity (hk-con-arity name)))
+      (cond
+        ((nil? arity) (raise (str "unknown constructor: " name)))
+        ((= arity 0) (hk-mk-con name (list)))
+        (:else
+          {:type "con-partial" :name name :arity arity :args (list)})))))
+
+(define
+  hk-eval-if
+  (fn
+    (node env)
+    (let ((cv (hk-force (hk-eval (nth node 1) env))))
+      (cond
+        ((hk-truthy? cv) (hk-eval (nth node 2) env))
+        ((and (list? cv) (= (first cv) "False"))
+          (hk-eval (nth node 3) env))
+        ((= cv true) (hk-eval (nth node 2) env))
+        ((= cv false) (hk-eval (nth node 3) env))
+        (:else (raise "if: condition is not Bool"))))))
+
+(define
+  hk-extend-env-with-match!
+  (fn
+    (env match-env)
+    (for-each
+      (fn (k) (dict-set! env k (get match-env k)))
+      (keys match-env))))
+
+(define
+  hk-eval-let-bind!
+  (fn
+    (b env)
+    (let ((tag (first b)))
+      (cond
+        ((= tag "fun-clause")
+          (let
+            ((name (nth b 1))
+              (pats (nth b 2))
+              (body (nth b 3)))
+            (cond
+              ((empty? pats)
+                (dict-set! env name (hk-eval body env)))
+              (:else
+                (dict-set! env name (hk-mk-closure pats body env))))))
+        ((or (= tag "bind") (= tag "pat-bind"))
+          (let ((pat (nth b 1)) (body (nth b 2)))
+            (let ((val (hk-eval body env)))
+              (let ((res (hk-match pat val env)))
+                (cond
+                  ((nil? res)
+                    (raise "let: pattern bind failure"))
+                  (:else
+                    (hk-extend-env-with-match! env res)))))))
+        (:else nil)))))
+
+(define
+  hk-eval-let
+  (fn
+    (binds body env)
+    (let ((new-env (hk-dict-copy env)))
+      ;; Pre-seed names for fn-clauses so closures see themselves
+      ;; (mutual recursion across the whole binding group).
+      (for-each
+        (fn (b)
+          (cond
+            ((= (first b) "fun-clause")
+              (dict-set! new-env (nth b 1) nil))
+            ((and
+                (= (first b) "bind")
+                (list? (nth b 1))
+                (= (first (nth b 1)) "p-var"))
+              (dict-set! new-env (nth (nth b 1) 1) nil))
+            (:else nil)))
+        binds)
+      (for-each (fn (b) (hk-eval-let-bind! b new-env)) binds)
+      (hk-eval body new-env))))
+
+(define
+  hk-eval-case
+  (fn
+    (scrut alts env)
+    (let ((sv (hk-force (hk-eval scrut env))))
+      (hk-try-alts alts sv env))))
+
+(define
+  hk-try-alts
+  (fn
+    (alts val env)
+    (cond
+      ((empty? alts) (raise "case: non-exhaustive patterns"))
+      (:else
+        (let
+          ((alt (first alts)))
+          (let
+            ((pat (nth alt 1)) (body (nth alt 2)))
+            (let
+              ((res (hk-match pat val env)))
+              (cond
+                ((nil? res) (hk-try-alts (rest alts) val env))
+                (:else (hk-eval body res))))))))))
+
+(define
+  hk-eval-op
+  (fn
+    (op left right env)
+    (cond
+      ;; Cons is non-strict in both args: build a cons cell whose
+      ;; head and tail are deferred. This is what makes `repeat x =
+      ;; x : repeat x` and `fibs = 0 : 1 : zipWith (+) fibs (tail
+      ;; fibs)` terminate.
+      ((= op ":")
+        (hk-mk-cons
+          (hk-mk-thunk left env)
+          (hk-mk-thunk right env)))
+      (:else
+        (let
+          ((lv (hk-force (hk-eval left env)))
+            (rv (hk-force (hk-eval right env))))
+          (hk-binop op lv rv))))))
+
+(define
+  hk-list-append
+  (fn
+    (a b)
+    (cond
+      ((and (list? a) (= (first a) "[]")) b)
+      ((and (list? a) (= (first a) ":"))
+        (hk-mk-cons (nth a 1) (hk-list-append (nth a 2) b)))
+      (:else (raise "++: not a list")))))
+
+;; Eager finite-range spine — handles [from..to] and [from,next..to].
+;; Step direction is governed by the sign of `step`; when step > 0 we
+;; stop at to; when step < 0 we stop at to going down.
+(define
+  hk-build-range
+  (fn
+    (from to step)
+    (cond
+      ((and (> step 0) (> from to)) (hk-mk-nil))
+      ((and (< step 0) (< from to)) (hk-mk-nil))
+      ((= step 0) (hk-mk-nil))
+      (:else
+        (hk-mk-cons from (hk-build-range (+ from step) to step))))))
+
+(define
+  hk-binop
+  (fn
+    (op lv rv)
+    (cond
+      ((= op "+") (+ lv rv))
+      ((= op "-") (- lv rv))
+      ((= op "*") (* lv rv))
+      ((= op "/") (/ lv rv))
+      ((= op "==") (hk-of-bool (= lv rv)))
+      ((= op "/=") (hk-of-bool (not (= lv rv))))
+      ((= op "<") (hk-of-bool (< lv rv)))
+      ((= op "<=") (hk-of-bool (<= lv rv)))
+      ((= op ">") (hk-of-bool (> lv rv)))
+      ((= op ">=") (hk-of-bool (>= lv rv)))
+      ((= op "&&") (hk-of-bool (and (hk-truthy? lv) (hk-truthy? rv))))
+      ((= op "||") (hk-of-bool (or (hk-truthy? lv) (hk-truthy? rv))))
+      ((= op ":") (hk-mk-cons lv rv))
+      ((= op "++") (hk-list-append lv rv))
+      (:else (raise (str "unknown operator: " op))))))
+
+(define
+  hk-eval-sect-left
+  (fn
+    (op e env)
+    ;; (e op) = \x -> e op x — bind e once, defer the operator call.
+    (let ((ev (hk-eval e env)))
+      (let ((cenv (hk-dict-copy env)))
+        (dict-set! cenv "__hk-sect-l" ev)
+        (hk-mk-closure
+          (list (list :p-var "__hk-sect-x"))
+          (list
+            :op
+            op
+            (list :var "__hk-sect-l")
+            (list :var "__hk-sect-x"))
+          cenv)))))
+
+(define
+  hk-eval-sect-right
+  (fn
+    (op e env)
+    (let ((ev (hk-eval e env)))
+      (let ((cenv (hk-dict-copy env)))
+        (dict-set! cenv "__hk-sect-r" ev)
+        (hk-mk-closure
+          (list (list :p-var "__hk-sect-x"))
+          (list
+            :op
+            op
+            (list :var "__hk-sect-x")
+            (list :var "__hk-sect-r"))
+          cenv)))))
+
+;; ── Top-level program evaluation ────────────────────────────
+;; Operator-as-value built-ins — let `(+)`, `(*)`, etc. work as
+;; first-class functions for `zipWith (+)` and friends. Strict in
+;; both args (built-ins are forced via hk-apply-builtin).
+(define
+  hk-make-binop-builtin
+  (fn
+    (name op-name)
+    (hk-mk-builtin
+      name
+      (fn (a b) (hk-binop op-name a b))
+      2)))
+
+;; Inline Prelude source — loaded into the initial env so simple
+;; programs can use `head`, `take`, `repeat`, etc. without each
+;; user file redefining them. The Prelude itself uses lazy `:` for
+;; the recursive list-building functions.
+(define
+  hk-prelude-src
+  "head (x:_) = x
+tail (_:xs) = xs
+fst (a, _) = a
+snd (_, b) = b
+take 0 _ = []
+take _ [] = []
+take n (x:xs) = x : take (n - 1) xs
+drop 0 xs = xs
+drop _ [] = []
+drop n (_:xs) = drop (n - 1) xs
+repeat x = x : repeat x
+iterate f x = x : iterate f (f x)
+length [] = 0
+length (_:xs) = 1 + length xs
+map _ [] = []
+map f (x:xs) = f x : map f xs
+filter _ [] = []
+filter p (x:xs) = if p x then x : filter p xs else filter p xs
+zipWith _ [] _ = []
+zipWith _ _ [] = []
+zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys
+fibs = 0 : 1 : zipWith plus fibs (tail fibs)
+plus a b = a + b
+")
+
+(define
+  hk-load-into!
+  (fn
+    (env src)
+    (let ((ast (hk-core src)))
+      (hk-register-program! ast)
+      (let
+        ((decls
+            (cond
+              ((= (first ast) "program") (nth ast 1))
+              ((= (first ast) "module") (nth ast 4))
+              (:else (list)))))
+        (hk-bind-decls! env decls)))))
+
+(define
+  hk-init-env
+  (fn
+    ()
+    (let ((env (dict)))
+      (dict-set! env "otherwise" hk-true)
+      (dict-set!
+        env
+        "error"
+        (hk-mk-builtin
+          "error"
+          (fn (msg) (raise (str "*** Exception: " msg)))
+          1))
+      (dict-set!
+        env
+        "not"
+        (hk-mk-builtin
+          "not"
+          (fn (b) (hk-of-bool (not (hk-truthy? b))))
+          1))
+      (dict-set!
+        env
+        "id"
+        (hk-mk-builtin "id" (fn (x) x) 1))
+      ;; `seq a b` — strict in `a`, lazy in `b`. Forces `a` to WHNF
+      ;; and returns `b` unchanged (still a thunk if it was one).
+      (dict-set!
+        env
+        "seq"
+        (hk-mk-lazy-builtin
+          "seq"
+          (fn (a b) (do (hk-force a) b))
+          2))
+      ;; `deepseq a b` — like seq but forces `a` to normal form.
+      (dict-set!
+        env
+        "deepseq"
+        (hk-mk-lazy-builtin
+          "deepseq"
+          (fn (a b) (do (hk-deep-force a) b))
+          2))
+      ;; ── Stub IO monad ─────────────────────────────────────
+      ;; IO actions are tagged values `("IO" payload)`; `>>=` and
+      ;; `>>` chain them. Lazy in the action arguments so do-blocks
+      ;; can be deeply structured without forcing the whole chain
+      ;; up front.
+      (dict-set!
+        env
+        "return"
+        (hk-mk-lazy-builtin
+          "return"
+          (fn (x) (list "IO" x))
+          1))
+      (dict-set!
+        env
+        ">>="
+        (hk-mk-lazy-builtin
+          ">>="
+          (fn (m f)
+            (let ((io-val (hk-force m)))
+              (cond
+                ((and
+                    (list? io-val)
+                    (= (first io-val) "IO"))
+                  (hk-apply (hk-force f) (nth io-val 1)))
+                (:else
+                  (raise "(>>=): left side is not an IO action")))))
+          2))
+      (dict-set!
+        env
+        ">>"
+        (hk-mk-lazy-builtin
+          ">>"
+          (fn (m n)
+            (let ((io-val (hk-force m)))
+              (cond
+                ((and
+                    (list? io-val)
+                    (= (first io-val) "IO"))
+                  (hk-force n))
+                (:else
+                  (raise "(>>): left side is not an IO action")))))
+          2))
+      ;; Operators as first-class values
+      (dict-set! env "+" (hk-make-binop-builtin "+" "+"))
+      (dict-set! env "-" (hk-make-binop-builtin "-" "-"))
+      (dict-set! env "*" (hk-make-binop-builtin "*" "*"))
+      (dict-set! env "/" (hk-make-binop-builtin "/" "/"))
+      (dict-set! env "==" (hk-make-binop-builtin "==" "=="))
+      (dict-set! env "/=" (hk-make-binop-builtin "/=" "/="))
+      (dict-set! env "<" (hk-make-binop-builtin "<" "<"))
+      (dict-set! env "<=" (hk-make-binop-builtin "<=" "<="))
+      (dict-set! env ">" (hk-make-binop-builtin ">" ">"))
+      (dict-set! env ">=" (hk-make-binop-builtin ">=" ">="))
+      (dict-set! env "&&" (hk-make-binop-builtin "&&" "&&"))
+      (dict-set! env "||" (hk-make-binop-builtin "||" "||"))
+      (dict-set! env "++" (hk-make-binop-builtin "++" "++"))
+      (hk-load-into! env hk-prelude-src)
+      env)))
+
+(define
+  hk-bind-decls!
+  (fn
+    (env decls)
+    (let ((groups (dict)) (pat-binds (list)))
+      ;; Pass 1: collect fun-clause groups by name; collect pat-binds
+      ;; in source order. Pre-seed env so any name can already be
+      ;; looked up by closures built in pass 2.
+      (for-each
+        (fn (d)
+          (cond
+            ((= (first d) "fun-clause")
+              (let
+                ((name (nth d 1)))
+                (dict-set!
+                  groups
+                  name
+                  (append
+                    (if
+                      (has-key? groups name)
+                      (get groups name)
+                      (list))
+                    (list (list (nth d 2) (nth d 3)))))
+                (when
+                  (not (has-key? env name))
+                  (dict-set! env name nil))))
+            ((or (= (first d) "bind") (= (first d) "pat-bind"))
+              (append! pat-binds d))
+            (:else nil)))
+        decls)
+      ;; Pass 2: install multifuns for arity > 0; mark 0-arity for
+      ;; pass 3. The mutable env means recursive references work.
+      (let ((zero-arity (list)))
+        (for-each
+          (fn (name)
+            (let ((clauses (get groups name)))
+              (let ((arity (len (first (first clauses)))))
+                (cond
+                  ((> arity 0)
+                    (dict-set!
+                      env
+                      name
+                      (hk-mk-multifun arity clauses env)))
+                  (:else (append! zero-arity name))))))
+          (keys groups))
+        ;; Pass 3: evaluate 0-arity bodies and pat-binds.
+        (for-each
+          (fn (name)
+            (let ((clauses (get groups name)))
+              (dict-set!
+                env
+                name
+                (hk-eval (first (rest (first clauses))) env))))
+          zero-arity)
+        (for-each
+          (fn (d)
+            (let ((pat (nth d 1)) (body (nth d 2)))
+              (let ((val (hk-eval body env)))
+                (let ((res (hk-match pat val env)))
+                  (cond
+                    ((nil? res)
+                      (raise "top-level pattern bind failure"))
+                    (:else (hk-extend-env-with-match! env res)))))))
+          pat-binds))
+      env)))
+
+(define
+  hk-eval-program
+  (fn
+    (ast)
+    (cond
+      ((nil? ast) (raise "eval-program: nil ast"))
+      ((not (list? ast)) (raise "eval-program: not a list"))
+      (:else
+        (do
+          (hk-register-program! ast)
+          (let ((env (hk-init-env)))
+            (let
+              ((decls
+                  (cond
+                    ((= (first ast) "program") (nth ast 1))
+                    ((= (first ast) "module") (nth ast 4))
+                    (:else (raise "eval-program: bad shape")))))
+              (hk-bind-decls! env decls))))))))
+
+;; ── Source-level convenience ────────────────────────────────
+(define
+  hk-run
+  (fn
+    (src)
+    (let ((env (hk-eval-program (hk-core src))))
+      (cond
+        ((has-key? env "main") (get env "main"))
+        (:else env)))))
+
+(define
+  hk-eval-expr-source
+  (fn
+    (src)
+    (hk-deep-force (hk-eval (hk-core-expr src) (hk-init-env)))))

lib/haskell/layout.sx

@@ -0,0 +1,329 @@
+;; Haskell 98 layout algorithm (§10.3).
+;;
+;; Consumes the raw token stream produced by hk-tokenize and inserts
+;; virtual braces / semicolons (types vlbrace / vrbrace / vsemi) based
+;; on indentation. Newline tokens are consumed and stripped.
+;;
+;;   (hk-layout (hk-tokenize src))  →  tokens-with-virtual-layout
+
+;; ── Pre-pass ──────────────────────────────────────────────────────
+;;
+;; Walks the raw token list and emits an augmented stream containing
+;; two fresh pseudo-tokens:
+;;
+;;   {:type "layout-open"   :col N :keyword K}
+;;     At stream start (K = "<module>") unless the first real token is
+;;     `module` or `{`. Also immediately after every `let` / `where` /
+;;     `do` / `of` whose following token is NOT `{`. N is the column
+;;     of the token that follows.
+;;
+;;   {:type "layout-indent" :col N}
+;;     Before any token whose line is strictly greater than the line
+;;     of the previously emitted real token, EXCEPT when that token
+;;     is already preceded by a layout-open (Haskell 98 §10.3 note 3).
+;;
+;; Raw newline tokens are dropped.
+
+(define
+  hk-layout-keyword?
+  (fn
+    (tok)
+    (and
+      (= (get tok "type") "reserved")
+      (or
+        (= (get tok "value") "let")
+        (= (get tok "value") "where")
+        (= (get tok "value") "do")
+        (= (get tok "value") "of")))))
+
+(define
+  hk-layout-pre
+  (fn
+    (tokens)
+    (let
+      ((result (list))
+        (n (len tokens))
+        (i 0)
+        (prev-line -1)
+        (first-real-emitted false)
+        (suppress-next-indent false))
+      (define
+        hk-next-real-idx
+        (fn
+          (start)
+          (let
+            ((j start))
+            (define
+              hk-nri-loop
+              (fn
+                ()
+                (when
+                  (and
+                    (< j n)
+                    (= (get (nth tokens j) "type") "newline"))
+                  (do (set! j (+ j 1)) (hk-nri-loop)))))
+            (hk-nri-loop)
+            j)))
+      (define
+        hk-pre-step
+        (fn
+          ()
+          (when
+            (< i n)
+            (let
+              ((tok (nth tokens i)) (ty (get tok "type")))
+              (cond
+                ((= ty "newline") (do (set! i (+ i 1)) (hk-pre-step)))
+                (:else
+                  (do
+                    (when
+                      (not first-real-emitted)
+                      (do
+                        (set! first-real-emitted true)
+                        (when
+                          (not
+                            (or
+                              (and
+                                (= ty "reserved")
+                                (= (get tok "value") "module"))
+                              (= ty "lbrace")))
+                          (do
+                            (append!
+                              result
+                              {:type "layout-open"
+                                :col (get tok "col")
+                                :keyword "<module>"
+                                :line (get tok "line")})
+                            (set! suppress-next-indent true)))))
+                    (when
+                      (and
+                        (>= prev-line 0)
+                        (> (get tok "line") prev-line)
+                        (not suppress-next-indent))
+                      (append!
+                        result
+                        {:type "layout-indent"
+                          :col (get tok "col")
+                          :line (get tok "line")}))
+                    (set! suppress-next-indent false)
+                    (set! prev-line (get tok "line"))
+                    (append! result tok)
+                    (when
+                      (hk-layout-keyword? tok)
+                      (let
+                        ((j (hk-next-real-idx (+ i 1))))
+                        (cond
+                          ((>= j n)
+                            (do
+                              (append!
+                                result
+                                {:type "layout-open"
+                                  :col 0
+                                  :keyword (get tok "value")
+                                  :line (get tok "line")})
+                              (set! suppress-next-indent true)))
+                          ((= (get (nth tokens j) "type") "lbrace") nil)
+                          (:else
+                            (do
+                              (append!
+                                result
+                                {:type "layout-open"
+                                  :col (get (nth tokens j) "col")
+                                  :keyword (get tok "value")
+                                  :line (get tok "line")})
+                              (set! suppress-next-indent true))))))
+                    (set! i (+ i 1))
+                    (hk-pre-step))))))))
+      (hk-pre-step)
+      result)))
+
+;; ── Main pass: L algorithm ────────────────────────────────────────
+;;
+;; Stack is a list; the head is the top of stack. Each entry is
+;; either the keyword :explicit (pushed by an explicit `{`) or a dict
+;; {:col N :keyword K} pushed by a layout-open marker.
+;;
+;; Rules (following Haskell 98 §10.3):
+;;
+;;   layout-open(n)  vs stack:
+;;     empty or explicit top                 → push n; emit {
+;;     n > top-col                           → push n; emit {
+;;     otherwise                             → emit { }; retry as indent(n)
+;;
+;;   layout-indent(n) vs stack:
+;;     empty or explicit top                 → drop
+;;     n == top-col                          → emit ;
+;;     n <  top-col                          → emit }; pop; recurse
+;;     n >  top-col                          → drop
+;;
+;;   lbrace                                  → push :explicit; emit {
+;;   rbrace                                  → pop if :explicit; emit }
+;;   `in` with implicit let on top           → emit }; pop; emit in
+;;   any other token                         → emit
+;;
+;; EOF: emit } for every remaining implicit context.
+
+(define
+  hk-layout-L
+  (fn
+    (pre-toks)
+    (let
+      ((result (list))
+        (stack (list))
+        (n (len pre-toks))
+        (i 0))
+      (define hk-emit (fn (t) (append! result t)))
+      (define
+        hk-indent-at
+        (fn
+          (col line)
+          (cond
+            ((or (empty? stack) (= (first stack) :explicit)) nil)
+            (:else
+              (let
+                ((top-col (get (first stack) "col")))
+                (cond
+                  ((= col top-col)
+                    (hk-emit
+                      {:type "vsemi" :value ";" :line line :col col}))
+                  ((< col top-col)
+                    (do
+                      (hk-emit
+                        {:type "vrbrace" :value "}" :line line :col col})
+                      (set! stack (rest stack))
+                      (hk-indent-at col line)))
+                  (:else nil)))))))
+      (define
+        hk-open-at
+        (fn
+          (col keyword line)
+          (cond
+            ((and
+                (> col 0)
+                (or
+                  (empty? stack)
+                  (= (first stack) :explicit)
+                  (> col (get (first stack) "col"))))
+              (do
+                (hk-emit
+                  {:type "vlbrace" :value "{" :line line :col col})
+                (set! stack (cons {:col col :keyword keyword} stack))))
+            (:else
+              (do
+                (hk-emit
+                  {:type "vlbrace" :value "{" :line line :col col})
+                (hk-emit
+                  {:type "vrbrace" :value "}" :line line :col col})
+                (hk-indent-at col line))))))
+      (define
+        hk-close-eof
+        (fn
+          ()
+          (when
+            (and
+              (not (empty? stack))
+              (not (= (first stack) :explicit)))
+            (do
+              (hk-emit {:type "vrbrace" :value "}" :line 0 :col 0})
+              (set! stack (rest stack))
+              (hk-close-eof)))))
+      ;; Peek past further layout-indent / layout-open markers to find
+      ;; the next real token's value when its type is `reserved`.
+      ;; Returns nil if no such token.
+      (define
+        hk-peek-next-reserved
+        (fn
+          (start)
+          (let ((j (+ start 1)) (found nil) (done false))
+            (define
+              hk-pnr-loop
+              (fn
+                ()
+                (when
+                  (and (not done) (< j n))
+                  (let
+                    ((t (nth pre-toks j)) (ty (get t "type")))
+                    (cond
+                      ((or
+                          (= ty "layout-indent")
+                          (= ty "layout-open"))
+                        (do (set! j (+ j 1)) (hk-pnr-loop)))
+                      ((= ty "reserved")
+                        (do (set! found (get t "value")) (set! done true)))
+                      (:else (set! done true)))))))
+            (hk-pnr-loop)
+            found)))
+      (define
+        hk-layout-step
+        (fn
+          ()
+          (when
+            (< i n)
+            (let
+              ((tok (nth pre-toks i)) (ty (get tok "type")))
+              (cond
+                ((= ty "eof")
+                  (do
+                    (hk-close-eof)
+                    (hk-emit tok)
+                    (set! i (+ i 1))
+                    (hk-layout-step)))
+                ((= ty "layout-open")
+                  (do
+                    (hk-open-at
+                      (get tok "col")
+                      (get tok "keyword")
+                      (get tok "line"))
+                    (set! i (+ i 1))
+                    (hk-layout-step)))
+                ((= ty "layout-indent")
+                  (cond
+                    ((= (hk-peek-next-reserved i) "in")
+                      (do (set! i (+ i 1)) (hk-layout-step)))
+                    (:else
+                      (do
+                        (hk-indent-at (get tok "col") (get tok "line"))
+                        (set! i (+ i 1))
+                        (hk-layout-step)))))
+                ((= ty "lbrace")
+                  (do
+                    (set! stack (cons :explicit stack))
+                    (hk-emit tok)
+                    (set! i (+ i 1))
+                    (hk-layout-step)))
+                ((= ty "rbrace")
+                  (do
+                    (when
+                      (and
+                        (not (empty? stack))
+                        (= (first stack) :explicit))
+                      (set! stack (rest stack)))
+                    (hk-emit tok)
+                    (set! i (+ i 1))
+                    (hk-layout-step)))
+                ((and
+                    (= ty "reserved")
+                    (= (get tok "value") "in")
+                    (not (empty? stack))
+                    (not (= (first stack) :explicit))
+                    (= (get (first stack) "keyword") "let"))
+                  (do
+                    (hk-emit
+                      {:type "vrbrace"
+                        :value "}"
+                        :line (get tok "line")
+                        :col (get tok "col")})
+                    (set! stack (rest stack))
+                    (hk-emit tok)
+                    (set! i (+ i 1))
+                    (hk-layout-step)))
+                (:else
+                  (do
+                    (hk-emit tok)
+                    (set! i (+ i 1))
+                    (hk-layout-step))))))))
+      (hk-layout-step)
+      (hk-close-eof)
+      result)))
+
+(define hk-layout (fn (tokens) (hk-layout-L (hk-layout-pre tokens))))

lib/haskell/match.sx

@@ -0,0 +1,201 @@
+;; Value-level pattern matching.
+;;
+;; Constructor values are tagged lists whose first element is the
+;; constructor name (a string). Tuples use the special tag "Tuple".
+;; Lists use the spine of `:` cons and `[]` nil.
+;;
+;;   Just 5         →  ("Just" 5)
+;;   Nothing        →  ("Nothing")
+;;   (1, 2)         →  ("Tuple" 1 2)
+;;   [1, 2]         →  (":" 1 (":" 2 ("[]")))
+;;   ()             →  ("()")
+;;
+;; Primitive values (numbers, strings, chars) are stored raw.
+;;
+;; The matcher takes a pattern AST node, a value, and an environment
+;; dict; it returns an extended dict on success, or `nil` on failure.
+
+;; ── Value builders ──────────────────────────────────────────
+(define
+  hk-mk-con
+  (fn
+    (cname args)
+    (let ((result (list cname)))
+      (for-each (fn (a) (append! result a)) args)
+      result)))
+
+(define
+  hk-mk-tuple
+  (fn
+    (items)
+    (let ((result (list "Tuple")))
+      (for-each (fn (x) (append! result x)) items)
+      result)))
+
+(define hk-mk-nil (fn () (list "[]")))
+
+(define hk-mk-cons (fn (h t) (list ":" h t)))
+
+(define
+  hk-mk-list
+  (fn
+    (items)
+    (cond
+      ((empty? items) (hk-mk-nil))
+      (:else
+        (hk-mk-cons (first items) (hk-mk-list (rest items)))))))
+
+;; ── Predicates / accessors on constructor values ───────────
+(define
+  hk-is-con-val?
+  (fn
+    (v)
+    (and
+      (list? v)
+      (not (empty? v))
+      (string? (first v)))))
+
+(define hk-val-con-name (fn (v) (first v)))
+
+(define hk-val-con-args (fn (v) (rest v)))
+
+;; ── The matcher ────────────────────────────────────────────
+;;
+;; Pattern match forces the scrutinee to WHNF before inspecting it
+;; — except for `p-wild`, `p-var`, and `p-lazy`, which never need
+;; to look at the value. Args of constructor / tuple / list values
+;; remain thunked (they're forced only when their own pattern needs
+;; to inspect them, recursively).
+(define
+  hk-match
+  (fn
+    (pat val env)
+    (cond
+      ((not (list? pat)) nil)
+      ((empty? pat) nil)
+      (:else
+        (let
+          ((tag (first pat)))
+          (cond
+            ((= tag "p-wild") env)
+            ((= tag "p-var") (assoc env (nth pat 1) val))
+            ((= tag "p-lazy") (hk-match (nth pat 1) val env))
+            ((= tag "p-as")
+              (let
+                ((res (hk-match (nth pat 2) val env)))
+                (cond
+                  ((nil? res) nil)
+                  (:else (assoc res (nth pat 1) val)))))
+            (:else
+              (let ((fv (hk-force val)))
+                (cond
+                  ((= tag "p-int")
+                    (if
+                      (and (number? fv) (= fv (nth pat 1)))
+                      env
+                      nil))
+                  ((= tag "p-float")
+                    (if
+                      (and (number? fv) (= fv (nth pat 1)))
+                      env
+                      nil))
+                  ((= tag "p-string")
+                    (if
+                      (and (string? fv) (= fv (nth pat 1)))
+                      env
+                      nil))
+                  ((= tag "p-char")
+                    (if
+                      (and (string? fv) (= fv (nth pat 1)))
+                      env
+                      nil))
+                  ((= tag "p-con")
+                    (let
+                      ((pat-name (nth pat 1)) (pat-args (nth pat 2)))
+                      (cond
+                        ((not (hk-is-con-val? fv)) nil)
+                        ((not (= (hk-val-con-name fv) pat-name)) nil)
+                        (:else
+                          (let
+                            ((val-args (hk-val-con-args fv)))
+                            (cond
+                              ((not (= (len pat-args) (len val-args)))
+                                nil)
+                              (:else
+                                (hk-match-all
+                                  pat-args
+                                  val-args
+                                  env))))))))
+                  ((= tag "p-tuple")
+                    (let
+                      ((items (nth pat 1)))
+                      (cond
+                        ((not (hk-is-con-val? fv)) nil)
+                        ((not (= (hk-val-con-name fv) "Tuple")) nil)
+                        ((not (= (len (hk-val-con-args fv)) (len items)))
+                          nil)
+                        (:else
+                          (hk-match-all
+                            items
+                            (hk-val-con-args fv)
+                            env)))))
+                  ((= tag "p-list")
+                    (hk-match-list-pat (nth pat 1) fv env))
+                  (:else nil))))))))))
+
+(define
+  hk-match-all
+  (fn
+    (pats vals env)
+    (cond
+      ((empty? pats) env)
+      (:else
+        (let
+          ((res (hk-match (first pats) (first vals) env)))
+          (cond
+            ((nil? res) nil)
+            (:else
+              (hk-match-all (rest pats) (rest vals) res))))))))
+
+(define
+  hk-match-list-pat
+  (fn
+    (items val env)
+    (let ((fv (hk-force val)))
+      (cond
+        ((empty? items)
+          (if
+            (and
+              (hk-is-con-val? fv)
+              (= (hk-val-con-name fv) "[]"))
+            env
+            nil))
+        (:else
+          (cond
+            ((not (hk-is-con-val? fv)) nil)
+            ((not (= (hk-val-con-name fv) ":")) nil)
+            (:else
+              (let
+                ((args (hk-val-con-args fv)))
+                (let
+                  ((h (first args)) (t (first (rest args))))
+                  (let
+                    ((res (hk-match (first items) h env)))
+                    (cond
+                      ((nil? res) nil)
+                      (:else
+                        (hk-match-list-pat
+                          (rest items)
+                          t
+                          res)))))))))))))
+
+;; ── Convenience: parse a pattern from source for tests ─────
+;; (Uses the parser's case-alt entry — `case _ of pat -> 0` —
+;; to extract a pattern AST.)
+(define
+  hk-parse-pat-source
+  (fn
+    (src)
+    (let
+      ((expr (hk-parse (str "case 0 of " src " -> 0"))))
+      (nth (nth (nth expr 2) 0) 1))))

lib/haskell/runtime.sx

@@ -0,0 +1,130 @@
+;; Haskell runtime: constructor registry.
+;;
+;; A mutable dict keyed by constructor name (e.g. "Just", "[]") with
+;; entries of shape  {:arity N :type TYPE-NAME-STRING}.
+;; Populated by ingesting `data` / `newtype` decls from parsed ASTs.
+;; Pre-registers a small set of constructors tied to Haskell syntactic
+;; forms (Bool, list, unit) — every nontrivial program depends on
+;; these, and the parser/desugar pipeline emits them as (:var "True")
+;; etc. without a corresponding `data` decl.
+
+(define hk-constructors (dict))
+
+(define
+  hk-register-con!
+  (fn
+    (cname arity type-name)
+    (dict-set!
+      hk-constructors
+      cname
+      {:arity arity :type type-name})))
+
+(define hk-is-con? (fn (name) (has-key? hk-constructors name)))
+
+(define
+  hk-con-arity
+  (fn
+    (name)
+    (if
+      (has-key? hk-constructors name)
+      (get (get hk-constructors name) "arity")
+      nil)))
+
+(define
+  hk-con-type
+  (fn
+    (name)
+    (if
+      (has-key? hk-constructors name)
+      (get (get hk-constructors name) "type")
+      nil)))
+
+(define hk-con-names (fn () (keys hk-constructors)))
+
+;; ── Registration from AST ────────────────────────────────────
+;; (:data NAME TVARS ((:con-def CNAME FIELDS) …))
+(define
+  hk-register-data!
+  (fn
+    (data-node)
+    (let
+      ((type-name (nth data-node 1))
+        (cons-list (nth data-node 3)))
+      (for-each
+        (fn
+          (cd)
+          (hk-register-con!
+            (nth cd 1)
+            (len (nth cd 2))
+            type-name))
+        cons-list))))
+
+;; (:newtype NAME TVARS CNAME FIELD)
+(define
+  hk-register-newtype!
+  (fn
+    (nt-node)
+    (hk-register-con!
+      (nth nt-node 3)
+      1
+      (nth nt-node 1))))
+
+;; Walk a decls list, registering every `data` / `newtype` decl.
+(define
+  hk-register-decls!
+  (fn
+    (decls)
+    (for-each
+      (fn
+        (d)
+        (cond
+          ((and
+              (list? d)
+              (not (empty? d))
+              (= (first d) "data"))
+            (hk-register-data! d))
+          ((and
+              (list? d)
+              (not (empty? d))
+              (= (first d) "newtype"))
+            (hk-register-newtype! d))
+          (:else nil)))
+      decls)))
+
+(define
+  hk-register-program!
+  (fn
+    (ast)
+    (cond
+      ((nil? ast) nil)
+      ((not (list? ast)) nil)
+      ((empty? ast) nil)
+      ((= (first ast) "program")
+        (hk-register-decls! (nth ast 1)))
+      ((= (first ast) "module")
+        (hk-register-decls! (nth ast 4)))
+      (:else nil))))
+
+;; Convenience: source → AST → desugar → register.
+(define
+  hk-load-source!
+  (fn (src) (hk-register-program! (hk-core src))))
+
+;; ── Built-in constructors pre-registered ─────────────────────
+;; Bool — used implicitly by `if`, comparison operators.
+(hk-register-con! "True" 0 "Bool")
+(hk-register-con! "False" 0 "Bool")
+;; List — used by list literals, range syntax, and cons operator.
+(hk-register-con! "[]" 0 "List")
+(hk-register-con! ":" 2 "List")
+;; Unit — produced by empty parens `()`.
+(hk-register-con! "()" 0 "Unit")
+;; Standard Prelude types — pre-registered so expression-level
+;; programs can use them without a `data` decl.
+(hk-register-con! "Nothing" 0 "Maybe")
+(hk-register-con! "Just"    1 "Maybe")
+(hk-register-con! "Left"    1 "Either")
+(hk-register-con! "Right"   1 "Either")
+(hk-register-con! "LT" 0 "Ordering")
+(hk-register-con! "EQ" 0 "Ordering")
+(hk-register-con! "GT" 0 "Ordering")

lib/haskell/test.sh

@@ -0,0 +1,118 @@
+#!/usr/bin/env bash
+# Fast Haskell-on-SX test runner — pipes directly to sx_server.exe.
+# No MCP, no Docker. All tests live in lib/haskell/tests/*.sx and
+# produce a summary dict at the end of each file.
+#
+# Usage:
+#   bash lib/haskell/test.sh              # run all tests
+#   bash lib/haskell/test.sh -v           # verbose — show each file's pass/fail
+#   bash lib/haskell/test.sh tests/parse.sx   # run one file
+
+set -euo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+if [ ! -x "$SX_SERVER" ]; then
+  # Fall back to the main-repo build if we're in a worktree.
+  MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
+  if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
+    SX_SERVER="$MAIN_ROOT/$SX_SERVER"
+  else
+    echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
+    exit 1
+  fi
+fi
+
+VERBOSE=""
+FILES=()
+for arg in "$@"; do
+  case "$arg" in
+    -v|--verbose) VERBOSE=1 ;;
+    *) FILES+=("$arg") ;;
+  esac
+done
+
+if [ ${#FILES[@]} -eq 0 ]; then
+  mapfile -t FILES < <(find lib/haskell/tests -maxdepth 2 -name '*.sx' | sort)
+fi
+
+TOTAL_PASS=0
+TOTAL_FAIL=0
+FAILED_FILES=()
+
+for FILE in "${FILES[@]}"; do
+  [ -f "$FILE" ] || { echo "skip $FILE (not found)"; continue; }
+  TMPFILE=$(mktemp)
+  cat > "$TMPFILE" <<EPOCHS
+(epoch 1)
+(load "lib/haskell/tokenizer.sx")
+(load "lib/haskell/layout.sx")
+(load "lib/haskell/parser.sx")
+(load "lib/haskell/desugar.sx")
+(load "lib/haskell/runtime.sx")
+(load "lib/haskell/match.sx")
+(load "lib/haskell/eval.sx")
+(load "lib/haskell/testlib.sx")
+(epoch 2)
+(load "$FILE")
+(epoch 3)
+(eval "(list hk-test-pass hk-test-fail)")
+EPOCHS
+
+  OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
+  rm -f "$TMPFILE"
+
+  # Output format: either "(ok 3 (P F))" on one line (short result) or
+  # "(ok-len 3 N)\n(P F)" where the value appears on the following line.
+  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
+  if [ -z "$LINE" ]; then
+    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
+            | sed -E 's/^\(ok 3 //; s/\)$//')
+  fi
+  if [ -z "$LINE" ]; then
+    echo "✗ $FILE: could not extract summary"
+    echo "$OUTPUT" | tail -20
+    TOTAL_FAIL=$((TOTAL_FAIL + 1))
+    FAILED_FILES+=("$FILE")
+    continue
+  fi
+  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
+  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
+  TOTAL_PASS=$((TOTAL_PASS + P))
+  TOTAL_FAIL=$((TOTAL_FAIL + F))
+  if [ "$F" -gt 0 ]; then
+    FAILED_FILES+=("$FILE")
+    printf '✗ %-40s %d/%d\n' "$FILE" "$P" "$((P+F))"
+    # Print failure names
+    TMPFILE2=$(mktemp)
+    cat > "$TMPFILE2" <<EPOCHS
+(epoch 1)
+(load "lib/haskell/tokenizer.sx")
+(load "lib/haskell/layout.sx")
+(load "lib/haskell/parser.sx")
+(load "lib/haskell/desugar.sx")
+(load "lib/haskell/runtime.sx")
+(load "lib/haskell/match.sx")
+(load "lib/haskell/eval.sx")
+(load "lib/haskell/testlib.sx")
+(epoch 2)
+(load "$FILE")
+(epoch 3)
+(eval "(map (fn (f) (get f \"name\")) hk-test-fails)")
+EPOCHS
+    FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok 3 ' || true)
+    rm -f "$TMPFILE2"
+    echo "    $FAILS"
+  elif [ "$VERBOSE" = "1" ]; then
+    printf '✓ %-40s %d passed\n' "$FILE" "$P"
+  fi
+done
+
+TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
+if [ $TOTAL_FAIL -eq 0 ]; then
+  echo "✓ $TOTAL_PASS/$TOTAL haskell-on-sx tests passed"
+else
+  echo "✗ $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed in: ${FAILED_FILES[*]}"
+fi
+
+[ $TOTAL_FAIL -eq 0 ]

lib/haskell/testlib.sx

@@ -0,0 +1,58 @@
+;; Shared test harness for Haskell-on-SX tests.
+;; Each test file expects hk-test / hk-deep=? / counters to already be bound.
+
+(define
+  hk-deep=?
+  (fn
+    (a b)
+    (cond
+      ((= a b) true)
+      ((and (dict? a) (dict? b))
+        (let
+          ((ak (keys a)) (bk (keys b)))
+          (if
+            (not (= (len ak) (len bk)))
+            false
+            (every?
+              (fn
+                (k)
+                (and (has-key? b k) (hk-deep=? (get a k) (get b k))))
+              ak))))
+      ((and (list? a) (list? b))
+        (if
+          (not (= (len a) (len b)))
+          false
+          (let
+            ((i 0) (ok true))
+            (define
+              hk-de-loop
+              (fn
+                ()
+                (when
+                  (and ok (< i (len a)))
+                  (do
+                    (when
+                      (not (hk-deep=? (nth a i) (nth b i)))
+                      (set! ok false))
+                    (set! i (+ i 1))
+                    (hk-de-loop)))))
+            (hk-de-loop)
+            ok)))
+      (:else false))))
+
+(define hk-test-pass 0)
+(define hk-test-fail 0)
+(define hk-test-fails (list))
+
+(define
+  hk-test
+  (fn
+    (name actual expected)
+    (if
+      (hk-deep=? actual expected)
+      (set! hk-test-pass (+ hk-test-pass 1))
+      (do
+        (set! hk-test-fail (+ hk-test-fail 1))
+        (append!
+          hk-test-fails
+          {:actual actual :expected expected :name name})))))

lib/haskell/tests/desugar.sx

@@ -0,0 +1,305 @@
+;; Desugar tests — surface AST → core AST.
+;;   :guarded   →  nested :if
+;;   :where     →  :let
+;;   :list-comp →  concatMap-based tree
+
+(define
+  hk-prog
+  (fn (&rest decls) (list :program decls)))
+
+;; ── Guards → if ──
+(hk-test
+  "two-way guarded rhs"
+  (hk-desugar (hk-parse-top "abs x | x < 0 = - x\n      | otherwise = x"))
+  (hk-prog
+    (list
+      :fun-clause
+      "abs"
+      (list (list :p-var "x"))
+      (list
+        :if
+        (list :op "<" (list :var "x") (list :int 0))
+        (list :neg (list :var "x"))
+        (list
+          :if
+          (list :var "otherwise")
+          (list :var "x")
+          (list
+            :app
+            (list :var "error")
+            (list :string "Non-exhaustive guards")))))))
+
+(hk-test
+  "three-way guarded rhs"
+  (hk-desugar
+    (hk-parse-top "sign n | n > 0 = 1\n       | n < 0 = -1\n       | otherwise = 0"))
+  (hk-prog
+    (list
+      :fun-clause
+      "sign"
+      (list (list :p-var "n"))
+      (list
+        :if
+        (list :op ">" (list :var "n") (list :int 0))
+        (list :int 1)
+        (list
+          :if
+          (list :op "<" (list :var "n") (list :int 0))
+          (list :neg (list :int 1))
+          (list
+            :if
+            (list :var "otherwise")
+            (list :int 0)
+            (list
+              :app
+              (list :var "error")
+              (list :string "Non-exhaustive guards"))))))))
+
+(hk-test
+  "case-alt guards desugared too"
+  (hk-desugar
+    (hk-parse "case x of\n  Just y | y > 0 -> y\n         | otherwise -> 0\n  Nothing -> -1"))
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list :p-con "Just" (list (list :p-var "y")))
+        (list
+          :if
+          (list :op ">" (list :var "y") (list :int 0))
+          (list :var "y")
+          (list
+            :if
+            (list :var "otherwise")
+            (list :int 0)
+            (list
+              :app
+              (list :var "error")
+              (list :string "Non-exhaustive guards")))))
+      (list
+        :alt
+        (list :p-con "Nothing" (list))
+        (list :neg (list :int 1))))))
+
+;; ── Where → let ──
+(hk-test
+  "where with single binding"
+  (hk-desugar (hk-parse-top "f x = y\n  where y = x + 1"))
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :let
+        (list
+          (list
+            :fun-clause
+            "y"
+            (list)
+            (list :op "+" (list :var "x") (list :int 1))))
+        (list :var "y")))))
+
+(hk-test
+  "where with two bindings"
+  (hk-desugar
+    (hk-parse-top "f x = y + z\n  where y = x + 1\n        z = x - 1"))
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :let
+        (list
+          (list
+            :fun-clause
+            "y"
+            (list)
+            (list :op "+" (list :var "x") (list :int 1)))
+          (list
+            :fun-clause
+            "z"
+            (list)
+            (list :op "-" (list :var "x") (list :int 1))))
+        (list :op "+" (list :var "y") (list :var "z"))))))
+
+(hk-test
+  "guards + where — guarded body inside let"
+  (hk-desugar
+    (hk-parse-top "f x | x > 0 = y\n    | otherwise = 0\n  where y = 99"))
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :let
+        (list (list :fun-clause "y" (list) (list :int 99)))
+        (list
+          :if
+          (list :op ">" (list :var "x") (list :int 0))
+          (list :var "y")
+          (list
+            :if
+            (list :var "otherwise")
+            (list :int 0)
+            (list
+              :app
+              (list :var "error")
+              (list :string "Non-exhaustive guards"))))))))
+
+;; ── List comprehensions → concatMap / if / let ──
+(hk-test
+  "list-comp: single generator"
+  (hk-core-expr "[x | x <- xs]")
+  (list
+    :app
+    (list
+      :app
+      (list :var "concatMap")
+      (list
+        :lambda
+        (list (list :p-var "x"))
+        (list :list (list (list :var "x")))))
+    (list :var "xs")))
+
+(hk-test
+  "list-comp: generator then guard"
+  (hk-core-expr "[x * 2 | x <- xs, x > 0]")
+  (list
+    :app
+    (list
+      :app
+      (list :var "concatMap")
+      (list
+        :lambda
+        (list (list :p-var "x"))
+        (list
+          :if
+          (list :op ">" (list :var "x") (list :int 0))
+          (list
+            :list
+            (list (list :op "*" (list :var "x") (list :int 2))))
+          (list :list (list)))))
+    (list :var "xs")))
+
+(hk-test
+  "list-comp: generator then let"
+  (hk-core-expr "[y | x <- xs, let y = x + 1]")
+  (list
+    :app
+    (list
+      :app
+      (list :var "concatMap")
+      (list
+        :lambda
+        (list (list :p-var "x"))
+        (list
+          :let
+          (list
+            (list
+              :bind
+              (list :p-var "y")
+              (list :op "+" (list :var "x") (list :int 1))))
+          (list :list (list (list :var "y"))))))
+    (list :var "xs")))
+
+(hk-test
+  "list-comp: two generators (nested concatMap)"
+  (hk-core-expr "[(x, y) | x <- xs, y <- ys]")
+  (list
+    :app
+    (list
+      :app
+      (list :var "concatMap")
+      (list
+        :lambda
+        (list (list :p-var "x"))
+        (list
+          :app
+          (list
+            :app
+            (list :var "concatMap")
+            (list
+              :lambda
+              (list (list :p-var "y"))
+              (list
+                :list
+                (list
+                  (list
+                    :tuple
+                    (list (list :var "x") (list :var "y")))))))
+          (list :var "ys"))))
+    (list :var "xs")))
+
+;; ── Pass-through cases ──
+(hk-test
+  "plain int literal unchanged"
+  (hk-core-expr "42")
+  (list :int 42))
+
+(hk-test
+  "lambda + if passes through"
+  (hk-core-expr "\\x -> if x > 0 then x else - x")
+  (list
+    :lambda
+    (list (list :p-var "x"))
+    (list
+      :if
+      (list :op ">" (list :var "x") (list :int 0))
+      (list :var "x")
+      (list :neg (list :var "x")))))
+
+(hk-test
+  "simple fun-clause (no guards/where) passes through"
+  (hk-desugar (hk-parse-top "id x = x"))
+  (hk-prog
+    (list
+      :fun-clause
+      "id"
+      (list (list :p-var "x"))
+      (list :var "x"))))
+
+(hk-test
+  "data decl passes through"
+  (hk-desugar (hk-parse-top "data Maybe a = Nothing | Just a"))
+  (hk-prog
+    (list
+      :data
+      "Maybe"
+      (list "a")
+      (list
+        (list :con-def "Nothing" (list))
+        (list :con-def "Just" (list (list :t-var "a")))))))
+
+(hk-test
+  "module header passes through, body desugared"
+  (hk-desugar
+    (hk-parse-top "module M where\nf x | x > 0 = 1\n    | otherwise = 0"))
+  (list
+    :module
+    "M"
+    nil
+    (list)
+    (list
+      (list
+        :fun-clause
+        "f"
+        (list (list :p-var "x"))
+        (list
+          :if
+          (list :op ">" (list :var "x") (list :int 0))
+          (list :int 1)
+          (list
+            :if
+            (list :var "otherwise")
+            (list :int 0)
+            (list
+              :app
+              (list :var "error")
+              (list :string "Non-exhaustive guards"))))))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/do-io.sx

@@ -0,0 +1,117 @@
+;; do-notation + stub IO monad. Desugaring is per Haskell 98 §3.14:
+;;   do { e ; ss }      = e >> do { ss }
+;;   do { p <- e ; ss } = e >>= \p -> do { ss }
+;;   do { let ds ; ss } = let ds in do { ss }
+;;   do { e }           = e
+;; The IO type is just `("IO" payload)` for now — no real side
+;; effects yet. `return`, `>>=`, `>>` are built-ins.
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+;; ── Single-statement do ──
+(hk-test
+  "do with a single expression"
+  (hk-eval-expr-source "do { return 5 }")
+  (list "IO" 5))
+
+(hk-test
+  "return wraps any expression"
+  (hk-eval-expr-source "return (1 + 2 * 3)")
+  (list "IO" 7))
+
+;; ── Bind threads results ──
+(hk-test
+  "single bind"
+  (hk-eval-expr-source
+    "do { x <- return 5 ; return (x + 1) }")
+  (list "IO" 6))
+
+(hk-test
+  "two binds"
+  (hk-eval-expr-source
+    "do\n  x <- return 5\n  y <- return 7\n  return (x + y)")
+  (list "IO" 12))
+
+(hk-test
+  "three binds — accumulating"
+  (hk-eval-expr-source
+    "do\n  a <- return 1\n  b <- return 2\n  c <- return 3\n  return (a + b + c)")
+  (list "IO" 6))
+
+;; ── Mixing >> and >>= ──
+(hk-test
+  ">> sequencing — last wins"
+  (hk-eval-expr-source
+    "do\n  return 1\n  return 2\n  return 3")
+  (list "IO" 3))
+
+(hk-test
+  ">> then >>= — last bind wins"
+  (hk-eval-expr-source
+    "do\n  return 99\n  x <- return 5\n  return x")
+  (list "IO" 5))
+
+;; ── do-let ──
+(hk-test
+  "do-let single binding"
+  (hk-eval-expr-source
+    "do\n  let x = 3\n  return (x * 2)")
+  (list "IO" 6))
+
+(hk-test
+  "do-let multi-bind, used after"
+  (hk-eval-expr-source
+    "do\n  let x = 4\n      y = 5\n  return (x * y)")
+  (list "IO" 20))
+
+(hk-test
+  "do-let interleaved with bind"
+  (hk-eval-expr-source
+    "do\n  x <- return 10\n  let y = x + 1\n  return (x * y)")
+  (list "IO" 110))
+
+;; ── Bind + pattern ──
+(hk-test
+  "bind to constructor pattern"
+  (hk-eval-expr-source
+    "do\n  Just x <- return (Just 7)\n  return (x + 100)")
+  (list "IO" 107))
+
+(hk-test
+  "bind to tuple pattern"
+  (hk-eval-expr-source
+    "do\n  (a, b) <- return (3, 4)\n  return (a * b)")
+  (list "IO" 12))
+
+;; ── User-defined IO functions ──
+(hk-test
+  "do inside top-level fun"
+  (hk-prog-val
+    "addM x y = do\n  a <- return x\n  b <- return y\n  return (a + b)\nresult = addM 5 6"
+    "result")
+  (list "IO" 11))
+
+(hk-test
+  "nested do"
+  (hk-eval-expr-source
+    "do\n  x <- do { y <- return 3 ; return (y + 1) }\n  return (x * 2)")
+  (list "IO" 8))
+
+;; ── (>>=) and (>>) used directly as functions ──
+(hk-test
+  ">>= used directly"
+  (hk-eval-expr-source
+    "(return 4) >>= (\\x -> return (x + 100))")
+  (list "IO" 104))
+
+(hk-test
+  ">> used directly"
+  (hk-eval-expr-source
+    "(return 1) >> (return 2)")
+  (list "IO" 2))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/eval.sx

@@ -0,0 +1,278 @@
+;; Strict evaluator tests. Each test parses, desugars, and evaluates
+;; either an expression (hk-eval-expr-source) or a full program
+;; (hk-eval-program → look up a named value).
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+;; ── Literals ──
+(hk-test "int literal" (hk-eval-expr-source "42") 42)
+(hk-test "float literal" (hk-eval-expr-source "3.14") 3.14)
+(hk-test "string literal" (hk-eval-expr-source "\"hi\"") "hi")
+(hk-test "char literal" (hk-eval-expr-source "'a'") "a")
+(hk-test "negative literal" (hk-eval-expr-source "- 5") -5)
+
+;; ── Arithmetic ──
+(hk-test "addition" (hk-eval-expr-source "1 + 2") 3)
+(hk-test
+  "precedence"
+  (hk-eval-expr-source "1 + 2 * 3")
+  7)
+(hk-test
+  "parens override precedence"
+  (hk-eval-expr-source "(1 + 2) * 3")
+  9)
+(hk-test
+  "subtraction left-assoc"
+  (hk-eval-expr-source "10 - 3 - 2")
+  5)
+
+;; ── Comparison + Bool ──
+(hk-test
+  "less than is True"
+  (hk-eval-expr-source "3 < 5")
+  (list "True"))
+(hk-test
+  "equality is False"
+  (hk-eval-expr-source "1 == 2")
+  (list "False"))
+(hk-test
+  "&& shortcuts"
+  (hk-eval-expr-source "(1 == 1) && (2 == 2)")
+  (list "True"))
+
+;; ── if / otherwise ──
+(hk-test
+  "if True"
+  (hk-eval-expr-source "if True then 1 else 2")
+  1)
+(hk-test
+  "if comparison branch"
+  (hk-eval-expr-source "if 5 > 3 then \"yes\" else \"no\"")
+  "yes")
+(hk-test "otherwise is True" (hk-eval-expr-source "otherwise") (list "True"))
+
+;; ── let ──
+(hk-test
+  "let single binding"
+  (hk-eval-expr-source "let x = 5 in x + 1")
+  6)
+(hk-test
+  "let two bindings"
+  (hk-eval-expr-source "let x = 1; y = 2 in x + y")
+  3)
+(hk-test
+  "let recursive: factorial 5"
+  (hk-eval-expr-source
+    "let f n = if n == 0 then 1 else n * f (n - 1) in f 5")
+  120)
+
+;; ── Lambdas ──
+(hk-test
+  "lambda apply"
+  (hk-eval-expr-source "(\\x -> x + 1) 5")
+  6)
+(hk-test
+  "lambda multi-arg"
+  (hk-eval-expr-source "(\\x y -> x * y) 3 4")
+  12)
+(hk-test
+  "lambda with constructor pattern"
+  (hk-eval-expr-source "(\\(Just x) -> x + 1) (Just 7)")
+  8)
+
+;; ── Constructors ──
+(hk-test
+  "0-arity constructor"
+  (hk-eval-expr-source "Nothing")
+  (list "Nothing"))
+(hk-test
+  "1-arity constructor applied"
+  (hk-eval-expr-source "Just 5")
+  (list "Just" 5))
+(hk-test
+  "True / False as bools"
+  (hk-eval-expr-source "True")
+  (list "True"))
+
+;; ── case ──
+(hk-test
+  "case Just"
+  (hk-eval-expr-source
+    "case Just 7 of Just x -> x ; Nothing -> 0")
+  7)
+(hk-test
+  "case Nothing"
+  (hk-eval-expr-source
+    "case Nothing of Just x -> x ; Nothing -> 99")
+  99)
+(hk-test
+  "case literal pattern"
+  (hk-eval-expr-source
+    "case 0 of 0 -> \"zero\" ; n -> \"other\"")
+  "zero")
+(hk-test
+  "case tuple"
+  (hk-eval-expr-source
+    "case (1, 2) of (a, b) -> a + b")
+  3)
+(hk-test
+  "case wildcard fallback"
+  (hk-eval-expr-source
+    "case 5 of 0 -> \"z\" ; _ -> \"nz\"")
+  "nz")
+
+;; ── List literals + cons ──
+(hk-test
+  "list literal as cons spine"
+  (hk-eval-expr-source "[1, 2, 3]")
+  (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
+(hk-test
+  "empty list literal"
+  (hk-eval-expr-source "[]")
+  (list "[]"))
+(hk-test
+  "cons via :"
+  (hk-eval-expr-source "1 : []")
+  (list ":" 1 (list "[]")))
+(hk-test
+  "++ concatenates lists"
+  (hk-eval-expr-source "[1, 2] ++ [3]")
+  (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
+
+;; ── Tuples ──
+(hk-test
+  "2-tuple"
+  (hk-eval-expr-source "(1, 2)")
+  (list "Tuple" 1 2))
+(hk-test
+  "3-tuple"
+  (hk-eval-expr-source "(\"a\", 5, True)")
+  (list "Tuple" "a" 5 (list "True")))
+
+;; ── Sections ──
+(hk-test
+  "right section (+ 1) applied"
+  (hk-eval-expr-source "(+ 1) 5")
+  6)
+(hk-test
+  "left section (10 -) applied"
+  (hk-eval-expr-source "(10 -) 4")
+  6)
+
+;; ── Multi-clause top-level functions ──
+(hk-test
+  "multi-clause: factorial"
+  (hk-prog-val
+    "fact 0 = 1\nfact n = n * fact (n - 1)\nresult = fact 6"
+    "result")
+  720)
+
+(hk-test
+  "multi-clause: list length via cons pattern"
+  (hk-prog-val
+    "len [] = 0\nlen (x:xs) = 1 + len xs\nresult = len [10, 20, 30, 40]"
+    "result")
+  4)
+
+(hk-test
+  "multi-clause: Maybe handler"
+  (hk-prog-val
+    "fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 (Just 9)"
+    "result")
+  9)
+
+(hk-test
+  "multi-clause: Maybe with default"
+  (hk-prog-val
+    "fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 Nothing"
+    "result")
+  0)
+
+;; ── User-defined data and matching ──
+(hk-test
+  "custom data with pattern match"
+  (hk-prog-val
+    "data Color = Red | Green | Blue\nname Red = \"red\"\nname Green = \"green\"\nname Blue = \"blue\"\nresult = name Green"
+    "result")
+  "green")
+
+(hk-test
+  "custom binary tree height"
+  (hk-prog-val
+    "data Tree = Leaf | Node Tree Tree\nh Leaf = 0\nh (Node l r) = 1 + max (h l) (h r)\nmax a b = if a > b then a else b\nresult = h (Node (Node Leaf Leaf) Leaf)"
+    "result")
+  2)
+
+;; ── Currying ──
+(hk-test
+  "partial application"
+  (hk-prog-val
+    "add x y = x + y\nadd5 = add 5\nresult = add5 7"
+    "result")
+  12)
+
+;; ── Higher-order ──
+(hk-test
+  "higher-order: function as arg"
+  (hk-prog-val
+    "twice f x = f (f x)\ninc x = x + 1\nresult = twice inc 10"
+    "result")
+  12)
+
+;; ── Error built-in ──
+(hk-test
+  "error short-circuits via if"
+  (hk-eval-expr-source
+    "if True then 1 else error \"unreachable\"")
+  1)
+
+;; ── Laziness: app args evaluate only when forced ──
+(hk-test
+  "second arg never forced"
+  (hk-eval-expr-source
+    "(\\x y -> x) 1 (error \"never\")")
+  1)
+
+(hk-test
+  "first arg never forced"
+  (hk-eval-expr-source
+    "(\\x y -> y) (error \"never\") 99")
+  99)
+
+(hk-test
+  "constructor argument is lazy under wildcard pattern"
+  (hk-eval-expr-source
+    "case Just (error \"deeply\") of Just _ -> 7 ; Nothing -> 0")
+  7)
+
+(hk-test
+  "lazy: const drops its second argument"
+  (hk-prog-val
+    "const x y = x\nresult = const 5 (error \"boom\")"
+    "result")
+  5)
+
+(hk-test
+  "lazy: head ignores tail"
+  (hk-prog-val
+    "myHead (x:_) = x\nresult = myHead (1 : (error \"tail\") : [])"
+    "result")
+  1)
+
+(hk-test
+  "lazy: Just on undefined evaluates only on force"
+  (hk-prog-val
+    "wrapped = Just (error \"oh no\")\nresult = case wrapped of Just _ -> True ; Nothing -> False"
+    "result")
+  (list "True"))
+
+;; ── not / id built-ins ──
+(hk-test "not True" (hk-eval-expr-source "not True") (list "False"))
+(hk-test "not False" (hk-eval-expr-source "not False") (list "True"))
+(hk-test "id" (hk-eval-expr-source "id 42") 42)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/infinite.sx

@@ -0,0 +1,137 @@
+;; Infinite structures + Prelude tests. The lazy `:` operator builds
+;; cons cells with thunked head/tail so recursive list-defining
+;; functions terminate when only a finite prefix is consumed.
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+(define hk-as-list
+  (fn (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+(define
+  hk-eval-list
+  (fn (src) (hk-as-list (hk-eval-expr-source src))))
+
+;; ── Prelude basics ──
+(hk-test "head of literal" (hk-eval-expr-source "head [1, 2, 3]") 1)
+(hk-test
+  "tail of literal"
+  (hk-eval-list "tail [1, 2, 3]")
+  (list 2 3))
+(hk-test "length" (hk-eval-expr-source "length [10, 20, 30, 40]") 4)
+(hk-test "length empty" (hk-eval-expr-source "length []") 0)
+(hk-test
+  "map with section"
+  (hk-eval-list "map (+ 1) [1, 2, 3]")
+  (list 2 3 4))
+(hk-test
+  "filter"
+  (hk-eval-list "filter (\\x -> x > 2) [1, 2, 3, 4, 5]")
+  (list 3 4 5))
+(hk-test
+  "drop"
+  (hk-eval-list "drop 2 [10, 20, 30, 40]")
+  (list 30 40))
+(hk-test "fst" (hk-eval-expr-source "fst (7, 9)") 7)
+(hk-test "snd" (hk-eval-expr-source "snd (7, 9)") 9)
+(hk-test
+  "zipWith"
+  (hk-eval-list "zipWith plus [1, 2, 3] [10, 20, 30]")
+  (list 11 22 33))
+
+;; ── Infinite structures ──
+(hk-test
+  "take from repeat"
+  (hk-eval-list "take 5 (repeat 7)")
+  (list 7 7 7 7 7))
+(hk-test
+  "take 0 from repeat returns empty"
+  (hk-eval-list "take 0 (repeat 7)")
+  (list))
+(hk-test
+  "take from iterate"
+  (hk-eval-list "take 5 (iterate (\\x -> x + 1) 0)")
+  (list 0 1 2 3 4))
+(hk-test
+  "iterate with multiplication"
+  (hk-eval-list "take 4 (iterate (\\x -> x * 2) 1)")
+  (list 1 2 4 8))
+(hk-test
+  "head of repeat"
+  (hk-eval-expr-source "head (repeat 99)")
+  99)
+
+;; ── Fibonacci stream ──
+(hk-test
+  "first 10 Fibonacci numbers"
+  (hk-eval-list "take 10 fibs")
+  (list 0 1 1 2 3 5 8 13 21 34))
+(hk-test
+  "fib at position 8"
+  (hk-eval-expr-source "head (drop 8 fibs)")
+  21)
+
+;; ── Building infinite structures in user code ──
+(hk-test
+  "user-defined infinite ones"
+  (hk-prog-val
+    "ones = 1 : ones\nresult = take 6 ones"
+    "result")
+  (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list "[]"))))))))
+
+(hk-test
+  "user-defined nats"
+  (hk-prog-val
+    "nats = naturalsFrom 1\nnaturalsFrom n = n : naturalsFrom (n + 1)\nresult = take 5 nats"
+    "result")
+  (list ":" 1 (list ":" 2 (list ":" 3 (list ":" 4 (list ":" 5 (list "[]")))))))
+
+;; ── Range syntax ──
+(hk-test
+  "finite range [1..5]"
+  (hk-eval-list "[1..5]")
+  (list 1 2 3 4 5))
+(hk-test
+  "empty range when from > to"
+  (hk-eval-list "[10..3]")
+  (list))
+(hk-test
+  "stepped range"
+  (hk-eval-list "[1, 3..10]")
+  (list 1 3 5 7 9))
+(hk-test
+  "open range — head"
+  (hk-eval-expr-source "head [1..]")
+  1)
+(hk-test
+  "open range — drop then head"
+  (hk-eval-expr-source "head (drop 99 [1..])")
+  100)
+(hk-test
+  "open range — take 5"
+  (hk-eval-list "take 5 [10..]")
+  (list 10 11 12 13 14))
+
+;; ── Composing Prelude functions ──
+(hk-test
+  "map then filter"
+  (hk-eval-list
+    "filter (\\x -> x > 5) (map (\\x -> x * 2) [1, 2, 3, 4])")
+  (list 6 8))
+
+(hk-test
+  "sum-via-foldless"
+  (hk-prog-val
+    "mySum [] = 0\nmySum (x:xs) = x + mySum xs\nresult = mySum (take 5 (iterate (\\x -> x + 1) 1))"
+    "result")
+  15)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/layout.sx

@@ -0,0 +1,245 @@
+;; Haskell layout-rule tests. hk-tokenizer + hk-layout produce a
+;; virtual-brace-annotated stream; these tests cover the algorithm
+;; from Haskell 98 §10.3 plus the pragmatic let/in single-line rule.
+
+;; Convenience — tokenize, run layout, strip eof, keep :type/:value.
+(define
+  hk-lay
+  (fn
+    (src)
+    (map
+      (fn (tok) {:value (get tok "value") :type (get tok "type")})
+      (filter
+        (fn (tok) (not (= (get tok "type") "eof")))
+        (hk-layout (hk-tokenize src))))))
+
+;; ── 1. Basics ──
+(hk-test
+  "empty input produces empty module { }"
+  (hk-lay "")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "}" :type "vrbrace"}))
+
+(hk-test
+  "single token → module open+close"
+  (hk-lay "foo")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "foo" :type "varid"}
+    {:value "}" :type "vrbrace"}))
+
+(hk-test
+  "two top-level decls get vsemi between"
+  (hk-lay "foo = 1\nbar = 2")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "foo" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value ";" :type "vsemi"}
+    {:value "bar" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 2 :type "integer"}
+    {:value "}" :type "vrbrace"}))
+
+;; ── 2. Layout keywords — do / let / where / of ──
+(hk-test
+  "do block with two stmts"
+  (hk-lay "f = do\n  x\n  y")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "f" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "do" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "x" :type "varid"}
+    {:value ";" :type "vsemi"}
+    {:value "y" :type "varid"}
+    {:value "}" :type "vrbrace"}
+    {:value "}" :type "vrbrace"}))
+
+(hk-test
+  "single-line let ... in"
+  (hk-lay "let x = 1 in x")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "let" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "x" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value "}" :type "vrbrace"}
+    {:value "in" :type "reserved"}
+    {:value "x" :type "varid"}
+    {:value "}" :type "vrbrace"}))
+
+(hk-test
+  "where block with two bindings"
+  (hk-lay "f = g\n  where\n    g = 1\n    h = 2")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "f" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "g" :type "varid"}
+    {:value "where" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "g" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value ";" :type "vsemi"}
+    {:value "h" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 2 :type "integer"}
+    {:value "}" :type "vrbrace"}
+    {:value "}" :type "vrbrace"}))
+
+(hk-test
+  "case … of with arms"
+  (hk-lay "f x = case x of\n  Just y -> y\n  Nothing -> 0")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "f" :type "varid"}
+    {:value "x" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "case" :type "reserved"}
+    {:value "x" :type "varid"}
+    {:value "of" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "Just" :type "conid"}
+    {:value "y" :type "varid"}
+    {:value "->" :type "reservedop"}
+    {:value "y" :type "varid"}
+    {:value ";" :type "vsemi"}
+    {:value "Nothing" :type "conid"}
+    {:value "->" :type "reservedop"}
+    {:value 0 :type "integer"}
+    {:value "}" :type "vrbrace"}
+    {:value "}" :type "vrbrace"}))
+
+;; ── 3. Explicit braces disable layout ──
+(hk-test
+  "explicit braces — no implicit vlbrace/vsemi/vrbrace inside"
+  (hk-lay "do { x ; y }")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "do" :type "reserved"}
+    {:value "{" :type "lbrace"}
+    {:value "x" :type "varid"}
+    {:value ";" :type "semi"}
+    {:value "y" :type "varid"}
+    {:value "}" :type "rbrace"}
+    {:value "}" :type "vrbrace"}))
+
+;; ── 4. Dedent closes nested blocks ──
+(hk-test
+  "dedent back to module level closes do block"
+  (hk-lay "f = do\n  x\n  y\ng = 2")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "f" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "do" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "x" :type "varid"}
+    {:value ";" :type "vsemi"}
+    {:value "y" :type "varid"}
+    {:value "}" :type "vrbrace"}
+    {:value ";" :type "vsemi"}
+    {:value "g" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 2 :type "integer"}
+    {:value "}" :type "vrbrace"}))
+
+(hk-test
+  "dedent closes inner let, emits vsemi at outer do level"
+  (hk-lay "main = do\n  let x = 1\n  print x")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "main" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "do" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "let" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "x" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value "}" :type "vrbrace"}
+    {:value ";" :type "vsemi"}
+    {:value "print" :type "varid"}
+    {:value "x" :type "varid"}
+    {:value "}" :type "vrbrace"}
+    {:value "}" :type "vrbrace"}))
+
+;; ── 5. Module header skips outer implicit open ──
+(hk-test
+  "module M where — only where opens a block"
+  (hk-lay "module M where\n  f = 1")
+  (list
+    {:value "module" :type "reserved"}
+    {:value "M" :type "conid"}
+    {:value "where" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "f" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value "}" :type "vrbrace"}))
+
+;; ── 6. Newlines are stripped ──
+(hk-test
+  "newline tokens do not appear in output"
+  (let
+    ((toks (hk-layout (hk-tokenize "foo\nbar"))))
+    (every?
+      (fn (t) (not (= (get t "type") "newline")))
+      toks))
+  true)
+
+;; ── 7. Continuation — deeper indent does NOT emit vsemi ──
+(hk-test
+  "line continuation (deeper indent) just merges"
+  (hk-lay "foo = 1 +\n   2")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "foo" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value "+" :type "varsym"}
+    {:value 2 :type "integer"}
+    {:value "}" :type "vrbrace"}))
+
+;; ── 8. Stack closing at EOF ──
+(hk-test
+  "EOF inside nested do closes all implicit blocks"
+  (let
+    ((toks (hk-lay "main = do\n  do\n    x")))
+    (let
+      ((n (len toks)))
+      (list
+        (get (nth toks (- n 1)) "type")
+        (get (nth toks (- n 2)) "type")
+        (get (nth toks (- n 3)) "type"))))
+  (list "vrbrace" "vrbrace" "vrbrace"))
+
+;; ── 9. Qualified-newline: x at deeper col than stack top does nothing ──
+(hk-test
+  "mixed where + do"
+  (hk-lay "f = do\n    x\n  where\n    x = 1")
+  (list
+    {:value "{" :type "vlbrace"}
+    {:value "f" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "do" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "x" :type "varid"}
+    {:value "}" :type "vrbrace"}
+    {:value "where" :type "reserved"}
+    {:value "{" :type "vlbrace"}
+    {:value "x" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value "}" :type "vrbrace"}
+    {:value "}" :type "vrbrace"}))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/match.sx

@@ -0,0 +1,256 @@
+;; Pattern-matcher tests. The matcher takes (pat val env) and returns
+;; an extended env dict on success, or `nil` on failure. Constructor
+;; values are tagged lists (con-name first); tuples use the "Tuple"
+;; tag; lists use chained `:` cons with `[]` nil.
+
+;; ── Atomic patterns ──
+(hk-test
+  "wildcard always matches"
+  (hk-match (list :p-wild) 42 (dict))
+  (dict))
+
+(hk-test
+  "var binds value"
+  (hk-match (list :p-var "x") 42 (dict))
+  {:x 42})
+
+(hk-test
+  "var preserves prior env"
+  (hk-match (list :p-var "y") 7 {:x 1})
+  {:x 1 :y 7})
+
+(hk-test
+  "int literal matches equal"
+  (hk-match (list :p-int 5) 5 (dict))
+  (dict))
+
+(hk-test
+  "int literal fails on mismatch"
+  (hk-match (list :p-int 5) 6 (dict))
+  nil)
+
+(hk-test
+  "negative int literal matches"
+  (hk-match (list :p-int -3) -3 (dict))
+  (dict))
+
+(hk-test
+  "string literal matches"
+  (hk-match (list :p-string "hi") "hi" (dict))
+  (dict))
+
+(hk-test
+  "string literal fails"
+  (hk-match (list :p-string "hi") "bye" (dict))
+  nil)
+
+(hk-test
+  "char literal matches"
+  (hk-match (list :p-char "a") "a" (dict))
+  (dict))
+
+;; ── Constructor patterns ──
+(hk-test
+  "0-arity con matches"
+  (hk-match
+    (list :p-con "Nothing" (list))
+    (hk-mk-con "Nothing" (list))
+    (dict))
+  (dict))
+
+(hk-test
+  "1-arity con matches and binds"
+  (hk-match
+    (list :p-con "Just" (list (list :p-var "y")))
+    (hk-mk-con "Just" (list 9))
+    (dict))
+  {:y 9})
+
+(hk-test
+  "con name mismatch fails"
+  (hk-match
+    (list :p-con "Just" (list (list :p-var "y")))
+    (hk-mk-con "Nothing" (list))
+    (dict))
+  nil)
+
+(hk-test
+  "con arity mismatch fails"
+  (hk-match
+    (list :p-con "Pair" (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-con "Pair" (list 1))
+    (dict))
+  nil)
+
+(hk-test
+  "nested con: Just (Just x)"
+  (hk-match
+    (list
+      :p-con
+      "Just"
+      (list
+        (list
+          :p-con
+          "Just"
+          (list (list :p-var "x")))))
+    (hk-mk-con "Just" (list (hk-mk-con "Just" (list 42))))
+    (dict))
+  {:x 42})
+
+;; ── Tuple patterns ──
+(hk-test
+  "2-tuple matches and binds"
+  (hk-match
+    (list
+      :p-tuple
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-tuple (list 10 20))
+    (dict))
+  {:a 10 :b 20})
+
+(hk-test
+  "tuple arity mismatch fails"
+  (hk-match
+    (list
+      :p-tuple
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-tuple (list 10 20 30))
+    (dict))
+  nil)
+
+;; ── List patterns ──
+(hk-test
+  "[] pattern matches empty list"
+  (hk-match (list :p-list (list)) (hk-mk-nil) (dict))
+  (dict))
+
+(hk-test
+  "[] pattern fails on non-empty"
+  (hk-match (list :p-list (list)) (hk-mk-list (list 1)) (dict))
+  nil)
+
+(hk-test
+  "[a] pattern matches singleton"
+  (hk-match
+    (list :p-list (list (list :p-var "a")))
+    (hk-mk-list (list 7))
+    (dict))
+  {:a 7})
+
+(hk-test
+  "[a, b] pattern matches pair-list and binds"
+  (hk-match
+    (list
+      :p-list
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-list (list 1 2))
+    (dict))
+  {:a 1 :b 2})
+
+(hk-test
+  "[a, b] fails on too-long list"
+  (hk-match
+    (list
+      :p-list
+      (list (list :p-var "a") (list :p-var "b")))
+    (hk-mk-list (list 1 2 3))
+    (dict))
+  nil)
+
+;; Cons-style infix pattern (which the parser produces as :p-con ":")
+(hk-test
+  "cons (h:t) on non-empty list"
+  (hk-match
+    (list
+      :p-con
+      ":"
+      (list (list :p-var "h") (list :p-var "t")))
+    (hk-mk-list (list 1 2 3))
+    (dict))
+  {:h 1 :t (list ":" 2 (list ":" 3 (list "[]")))})
+
+(hk-test
+  "cons fails on empty list"
+  (hk-match
+    (list
+      :p-con
+      ":"
+      (list (list :p-var "h") (list :p-var "t")))
+    (hk-mk-nil)
+    (dict))
+  nil)
+
+;; ── as patterns ──
+(hk-test
+  "as binds whole + sub-pattern"
+  (hk-match
+    (list
+      :p-as
+      "all"
+      (list :p-con "Just" (list (list :p-var "x"))))
+    (hk-mk-con "Just" (list 99))
+    (dict))
+  {:all (list "Just" 99) :x 99})
+
+(hk-test
+  "as on wildcard binds whole"
+  (hk-match
+    (list :p-as "v" (list :p-wild))
+    "anything"
+    (dict))
+  {:v "anything"})
+
+(hk-test
+  "as fails when sub-pattern fails"
+  (hk-match
+    (list
+      :p-as
+      "n"
+      (list :p-con "Just" (list (list :p-var "x"))))
+    (hk-mk-con "Nothing" (list))
+    (dict))
+  nil)
+
+;; ── lazy ~ pattern (eager equivalent for now) ──
+(hk-test
+  "lazy pattern eager-matches its inner"
+  (hk-match
+    (list :p-lazy (list :p-var "y"))
+    42
+    (dict))
+  {:y 42})
+
+;; ── Source-driven: parse a real Haskell pattern, match a value ──
+(hk-test
+  "parsed pattern: Just x against Just 5"
+  (hk-match
+    (hk-parse-pat-source "Just x")
+    (hk-mk-con "Just" (list 5))
+    (dict))
+  {:x 5})
+
+(hk-test
+  "parsed pattern: x : xs against [10, 20, 30]"
+  (hk-match
+    (hk-parse-pat-source "x : xs")
+    (hk-mk-list (list 10 20 30))
+    (dict))
+  {:x 10 :xs (list ":" 20 (list ":" 30 (list "[]")))})
+
+(hk-test
+  "parsed pattern: (a, b) against (1, 2)"
+  (hk-match
+    (hk-parse-pat-source "(a, b)")
+    (hk-mk-tuple (list 1 2))
+    (dict))
+  {:a 1 :b 2})
+
+(hk-test
+  "parsed pattern: n@(Just x) against Just 7"
+  (hk-match
+    (hk-parse-pat-source "n@(Just x)")
+    (hk-mk-con "Just" (list 7))
+    (dict))
+  {:n (list "Just" 7) :x 7})
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parse.sx

@@ -0,0 +1,199 @@
+;; Haskell parser / tokenizer tests.
+;;
+;; Lightweight runner: each test checks actual vs expected with
+;; structural (deep) equality and accumulates pass/fail counters.
+;; Final value of this file is a summary dict with :pass :fail :fails.
+;; The hk-test / hk-deep=? helpers live in lib/haskell/testlib.sx
+;; and are preloaded by lib/haskell/test.sh.
+
+;; Convenience: tokenize and drop newline + eof tokens so tests focus
+;; on meaningful content. Returns list of {:type :value} pairs.
+(define
+  hk-toks
+  (fn
+    (src)
+    (map
+      (fn (tok) {:value (get tok "value") :type (get tok "type")})
+      (filter
+        (fn
+          (tok)
+          (let
+            ((ty (get tok "type")))
+            (not (or (= ty "newline") (= ty "eof")))))
+        (hk-tokenize src)))))
+
+;; ── 1. Identifiers & reserved words ──
+(hk-test "varid simple" (hk-toks "foo") (list {:value "foo" :type "varid"}))
+
+(hk-test
+  "varid with digits and prime"
+  (hk-toks "foo123' bar2")
+  (list {:value "foo123'" :type "varid"} {:value "bar2" :type "varid"}))
+
+(hk-test "conid" (hk-toks "Maybe") (list {:value "Maybe" :type "conid"}))
+
+(hk-test "reserved: where" (hk-toks "where") (list {:value "where" :type "reserved"}))
+
+(hk-test
+  "reserved: case of"
+  (hk-toks "case of")
+  (list {:value "case" :type "reserved"} {:value "of" :type "reserved"}))
+
+(hk-test "underscore is reserved" (hk-toks "_") (list {:value "_" :type "reserved"}))
+
+;; ── 2. Qualified names ──
+(hk-test "qvarid" (hk-toks "Data.Map.lookup") (list {:value "Data.Map.lookup" :type "qvarid"}))
+
+(hk-test "qconid" (hk-toks "Data.Map") (list {:value "Data.Map" :type "qconid"}))
+
+(hk-test "qualified operator" (hk-toks "Prelude.+") (list {:value "Prelude.+" :type "varsym"}))
+
+;; ── 3. Numbers ──
+(hk-test "integer" (hk-toks "42") (list {:value 42 :type "integer"}))
+
+(hk-test "hex" (hk-toks "0x2A") (list {:value 42 :type "integer"}))
+
+(hk-test "octal" (hk-toks "0o17") (list {:value 15 :type "integer"}))
+
+(hk-test "float" (hk-toks "3.14") (list {:value 3.14 :type "float"}))
+
+(hk-test "float with exp" (hk-toks "1.5e-3") (list {:value 0.0015 :type "float"}))
+
+;; ── 4. Strings / chars ──
+(hk-test "string" (hk-toks "\"hello\"") (list {:value "hello" :type "string"}))
+
+(hk-test "char" (hk-toks "'a'") (list {:value "a" :type "char"}))
+
+(hk-test "char escape newline" (hk-toks "'\\n'") (list {:value "\n" :type "char"}))
+
+(hk-test "string escape" (hk-toks "\"a\\nb\"") (list {:value "a\nb" :type "string"}))
+
+;; ── 5. Operators ──
+(hk-test "operator +" (hk-toks "+") (list {:value "+" :type "varsym"}))
+
+(hk-test "operator >>=" (hk-toks ">>=") (list {:value ">>=" :type "varsym"}))
+
+(hk-test "consym" (hk-toks ":+:") (list {:value ":+:" :type "consym"}))
+
+(hk-test "reservedop ->" (hk-toks "->") (list {:value "->" :type "reservedop"}))
+
+(hk-test "reservedop =>" (hk-toks "=>") (list {:value "=>" :type "reservedop"}))
+
+(hk-test "reservedop .. (range)" (hk-toks "..") (list {:value ".." :type "reservedop"}))
+
+(hk-test "reservedop backslash" (hk-toks "\\") (list {:value "\\" :type "reservedop"}))
+
+;; ── 6. Punctuation ──
+(hk-test "parens" (hk-toks "( )") (list {:value "(" :type "lparen"} {:value ")" :type "rparen"}))
+
+(hk-test "brackets" (hk-toks "[]") (list {:value "[" :type "lbracket"} {:value "]" :type "rbracket"}))
+
+(hk-test "braces" (hk-toks "{}") (list {:value "{" :type "lbrace"} {:value "}" :type "rbrace"}))
+
+(hk-test
+  "backtick"
+  (hk-toks "`mod`")
+  (list {:value "`" :type "backtick"} {:value "mod" :type "varid"} {:value "`" :type "backtick"}))
+
+(hk-test "comma and semi" (hk-toks ",;") (list {:value "," :type "comma"} {:value ";" :type "semi"}))
+
+;; ── 7. Comments ──
+(hk-test "line comment stripped" (hk-toks "-- a comment") (list))
+
+(hk-test "line comment before code" (hk-toks "-- c\nfoo") (list {:value "foo" :type "varid"}))
+
+(hk-test
+  "block comment stripped"
+  (hk-toks "{- block -} foo")
+  (list {:value "foo" :type "varid"}))
+
+(hk-test
+  "nested block comment"
+  (hk-toks "{- {- nested -} -} x")
+  (list {:value "x" :type "varid"}))
+
+(hk-test
+  "-- inside operator is comment in Haskell"
+  (hk-toks "-->")
+  (list {:value "-->" :type "varsym"}))
+
+;; ── 8. Mixed declarations ──
+(hk-test
+  "type signature"
+  (hk-toks "main :: IO ()")
+  (list {:value "main" :type "varid"} {:value "::" :type "reservedop"} {:value "IO" :type "conid"} {:value "(" :type "lparen"} {:value ")" :type "rparen"}))
+
+(hk-test
+  "data declaration"
+  (hk-toks "data Maybe a = Nothing | Just a")
+  (list
+    {:value "data" :type "reserved"}
+    {:value "Maybe" :type "conid"}
+    {:value "a" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value "Nothing" :type "conid"}
+    {:value "|" :type "reservedop"}
+    {:value "Just" :type "conid"}
+    {:value "a" :type "varid"}))
+
+(hk-test
+  "lambda"
+  (hk-toks "\\x -> x + 1")
+  (list {:value "\\" :type "reservedop"} {:value "x" :type "varid"} {:value "->" :type "reservedop"} {:value "x" :type "varid"} {:value "+" :type "varsym"} {:value 1 :type "integer"}))
+
+(hk-test
+  "let expression"
+  (hk-toks "let x = 1 in x + x")
+  (list
+    {:value "let" :type "reserved"}
+    {:value "x" :type "varid"}
+    {:value "=" :type "reservedop"}
+    {:value 1 :type "integer"}
+    {:value "in" :type "reserved"}
+    {:value "x" :type "varid"}
+    {:value "+" :type "varsym"}
+    {:value "x" :type "varid"}))
+
+(hk-test
+  "case expr"
+  (hk-toks "case x of Just y -> y")
+  (list
+    {:value "case" :type "reserved"}
+    {:value "x" :type "varid"}
+    {:value "of" :type "reserved"}
+    {:value "Just" :type "conid"}
+    {:value "y" :type "varid"}
+    {:value "->" :type "reservedop"}
+    {:value "y" :type "varid"}))
+
+(hk-test
+  "list literal"
+  (hk-toks "[1, 2, 3]")
+  (list
+    {:value "[" :type "lbracket"}
+    {:value 1 :type "integer"}
+    {:value "," :type "comma"}
+    {:value 2 :type "integer"}
+    {:value "," :type "comma"}
+    {:value 3 :type "integer"}
+    {:value "]" :type "rbracket"}))
+
+(hk-test
+  "range syntax"
+  (hk-toks "[1..10]")
+  (list {:value "[" :type "lbracket"} {:value 1 :type "integer"} {:value ".." :type "reservedop"} {:value 10 :type "integer"} {:value "]" :type "rbracket"}))
+
+;; ── 9. Positions ──
+(hk-test
+  "line/col positions"
+  (let
+    ((toks (hk-tokenize "foo\n  bar")))
+    (list
+      (get (nth toks 0) "line")
+      (get (nth toks 0) "col")
+      (get (nth toks 2) "line")
+      (get (nth toks 2) "col")))
+  (list 1 1 2 3))
+
+;; ── Summary — final value of this file ──
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-case-do.sx

@@ -0,0 +1,278 @@
+;; case-of and do-notation parser tests.
+;; Covers the minimal patterns needed to make these meaningful: var,
+;; wildcard, literal, constructor (with and without args), tuple, list.
+
+;; ── Patterns (in case arms) ──
+(hk-test
+  "wildcard pat"
+  (hk-parse "case x of _ -> 0")
+  (list
+    :case
+    (list :var "x")
+    (list (list :alt (list :p-wild) (list :int 0)))))
+
+(hk-test
+  "var pat"
+  (hk-parse "case x of y -> y")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list :alt (list :p-var "y") (list :var "y")))))
+
+(hk-test
+  "0-arity constructor pat"
+  (hk-parse "case x of\n  Nothing -> 0\n  Just y -> y")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list :alt (list :p-con "Nothing" (list)) (list :int 0))
+      (list
+        :alt
+        (list :p-con "Just" (list (list :p-var "y")))
+        (list :var "y")))))
+
+(hk-test
+  "int literal pat"
+  (hk-parse "case n of\n  0 -> 1\n  _ -> n")
+  (list
+    :case
+    (list :var "n")
+    (list
+      (list :alt (list :p-int 0) (list :int 1))
+      (list :alt (list :p-wild) (list :var "n")))))
+
+(hk-test
+  "string literal pat"
+  (hk-parse "case s of\n  \"hi\" -> 1\n  _ -> 0")
+  (list
+    :case
+    (list :var "s")
+    (list
+      (list :alt (list :p-string "hi") (list :int 1))
+      (list :alt (list :p-wild) (list :int 0)))))
+
+(hk-test
+  "tuple pat"
+  (hk-parse "case p of (a, b) -> a")
+  (list
+    :case
+    (list :var "p")
+    (list
+      (list
+        :alt
+        (list
+          :p-tuple
+          (list (list :p-var "a") (list :p-var "b")))
+        (list :var "a")))))
+
+(hk-test
+  "list pat"
+  (hk-parse "case xs of\n  [] -> 0\n  [a] -> a")
+  (list
+    :case
+    (list :var "xs")
+    (list
+      (list :alt (list :p-list (list)) (list :int 0))
+      (list
+        :alt
+        (list :p-list (list (list :p-var "a")))
+        (list :var "a")))))
+
+(hk-test
+  "nested constructor pat"
+  (hk-parse "case x of\n  Just (a, b) -> a\n  _ -> 0")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list
+          :p-con
+          "Just"
+          (list
+            (list
+              :p-tuple
+              (list (list :p-var "a") (list :p-var "b")))))
+        (list :var "a"))
+      (list :alt (list :p-wild) (list :int 0)))))
+
+(hk-test
+  "constructor with multiple var args"
+  (hk-parse "case t of Pair a b -> a")
+  (list
+    :case
+    (list :var "t")
+    (list
+      (list
+        :alt
+        (list
+          :p-con
+          "Pair"
+          (list (list :p-var "a") (list :p-var "b")))
+        (list :var "a")))))
+
+;; ── case-of shapes ──
+(hk-test
+  "case with explicit braces"
+  (hk-parse "case x of { Just y -> y ; Nothing -> 0 }")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list :p-con "Just" (list (list :p-var "y")))
+        (list :var "y"))
+      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
+
+(hk-test
+  "case scrutinee is a full expression"
+  (hk-parse "case f x + 1 of\n  y -> y")
+  (list
+    :case
+    (list
+      :op
+      "+"
+      (list :app (list :var "f") (list :var "x"))
+      (list :int 1))
+    (list (list :alt (list :p-var "y") (list :var "y")))))
+
+(hk-test
+  "case arm body is full expression"
+  (hk-parse "case x of\n  Just y -> y + 1")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list :p-con "Just" (list (list :p-var "y")))
+        (list :op "+" (list :var "y") (list :int 1))))))
+
+;; ── do blocks ──
+(hk-test
+  "do with two expressions"
+  (hk-parse "do\n  putStrLn \"hi\"\n  return 0")
+  (list
+    :do
+    (list
+      (list
+        :do-expr
+        (list :app (list :var "putStrLn") (list :string "hi")))
+      (list
+        :do-expr
+        (list :app (list :var "return") (list :int 0))))))
+
+(hk-test
+  "do with bind"
+  (hk-parse "do\n  x <- getLine\n  putStrLn x")
+  (list
+    :do
+    (list
+      (list :do-bind (list :p-var "x") (list :var "getLine"))
+      (list
+        :do-expr
+        (list :app (list :var "putStrLn") (list :var "x"))))))
+
+(hk-test
+  "do with let"
+  (hk-parse "do\n  let y = 5\n  print y")
+  (list
+    :do
+    (list
+      (list
+        :do-let
+        (list (list :bind (list :p-var "y") (list :int 5))))
+      (list
+        :do-expr
+        (list :app (list :var "print") (list :var "y"))))))
+
+(hk-test
+  "do with multiple let bindings"
+  (hk-parse "do\n  let x = 1\n      y = 2\n  print (x + y)")
+  (list
+    :do
+    (list
+      (list
+        :do-let
+        (list
+          (list :bind (list :p-var "x") (list :int 1))
+          (list :bind (list :p-var "y") (list :int 2))))
+      (list
+        :do-expr
+        (list
+          :app
+          (list :var "print")
+          (list :op "+" (list :var "x") (list :var "y")))))))
+
+(hk-test
+  "do with bind using constructor pat"
+  (hk-parse "do\n  Just x <- getMaybe\n  return x")
+  (list
+    :do
+    (list
+      (list
+        :do-bind
+        (list :p-con "Just" (list (list :p-var "x")))
+        (list :var "getMaybe"))
+      (list
+        :do-expr
+        (list :app (list :var "return") (list :var "x"))))))
+
+(hk-test
+  "do with explicit braces"
+  (hk-parse "do { x <- a ; y <- b ; return (x + y) }")
+  (list
+    :do
+    (list
+      (list :do-bind (list :p-var "x") (list :var "a"))
+      (list :do-bind (list :p-var "y") (list :var "b"))
+      (list
+        :do-expr
+        (list
+          :app
+          (list :var "return")
+          (list :op "+" (list :var "x") (list :var "y")))))))
+
+;; ── Mixing case/do inside expressions ──
+(hk-test
+  "case inside let"
+  (hk-parse "let f = \\x -> case x of\n                 Just y -> y\n                 _ -> 0\nin f 5")
+  (list
+    :let
+    (list
+      (list
+        :bind
+        (list :p-var "f")
+        (list
+          :lambda
+          (list (list :p-var "x"))
+          (list
+            :case
+            (list :var "x")
+            (list
+              (list
+                :alt
+                (list :p-con "Just" (list (list :p-var "y")))
+                (list :var "y"))
+              (list :alt (list :p-wild) (list :int 0)))))))
+    (list :app (list :var "f") (list :int 5))))
+
+(hk-test
+  "lambda containing do"
+  (hk-parse "\\x -> do\n  y <- x\n  return y")
+  (list
+    :lambda
+    (list (list :p-var "x"))
+    (list
+      :do
+      (list
+        (list :do-bind (list :p-var "y") (list :var "x"))
+        (list
+          :do-expr
+          (list :app (list :var "return") (list :var "y")))))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-decls.sx

@@ -0,0 +1,273 @@
+;; Top-level declarations: function clauses, type signatures, data,
+;; type, newtype, fixity. Driven by hk-parse-top which produces
+;; a (:program DECLS) node.
+
+(define
+  hk-prog
+  (fn
+    (&rest decls)
+    (list :program decls)))
+
+;; ── Function clauses & pattern bindings ──
+(hk-test
+  "simple fun-clause"
+  (hk-parse-top "f x = x + 1")
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list :op "+" (list :var "x") (list :int 1)))))
+
+(hk-test
+  "nullary decl"
+  (hk-parse-top "answer = 42")
+  (hk-prog
+    (list :fun-clause "answer" (list) (list :int 42))))
+
+(hk-test
+  "multi-clause fn (separate defs for each pattern)"
+  (hk-parse-top "fact 0 = 1\nfact n = n")
+  (hk-prog
+    (list :fun-clause "fact" (list (list :p-int 0)) (list :int 1))
+    (list
+      :fun-clause
+      "fact"
+      (list (list :p-var "n"))
+      (list :var "n"))))
+
+(hk-test
+  "constructor pattern in fn args"
+  (hk-parse-top "fromJust (Just x) = x")
+  (hk-prog
+    (list
+      :fun-clause
+      "fromJust"
+      (list (list :p-con "Just" (list (list :p-var "x"))))
+      (list :var "x"))))
+
+(hk-test
+  "pattern binding at top level"
+  (hk-parse-top "(a, b) = pair")
+  (hk-prog
+    (list
+      :pat-bind
+      (list
+        :p-tuple
+        (list (list :p-var "a") (list :p-var "b")))
+      (list :var "pair"))))
+
+;; ── Type signatures ──
+(hk-test
+  "single-name sig"
+  (hk-parse-top "f :: Int -> Int")
+  (hk-prog
+    (list
+      :type-sig
+      (list "f")
+      (list :t-fun (list :t-con "Int") (list :t-con "Int")))))
+
+(hk-test
+  "multi-name sig"
+  (hk-parse-top "f, g, h :: Int -> Bool")
+  (hk-prog
+    (list
+      :type-sig
+      (list "f" "g" "h")
+      (list :t-fun (list :t-con "Int") (list :t-con "Bool")))))
+
+(hk-test
+  "sig with type application"
+  (hk-parse-top "f :: Maybe a -> a")
+  (hk-prog
+    (list
+      :type-sig
+      (list "f")
+      (list
+        :t-fun
+        (list :t-app (list :t-con "Maybe") (list :t-var "a"))
+        (list :t-var "a")))))
+
+(hk-test
+  "sig with list type"
+  (hk-parse-top "len :: [a] -> Int")
+  (hk-prog
+    (list
+      :type-sig
+      (list "len")
+      (list
+        :t-fun
+        (list :t-list (list :t-var "a"))
+        (list :t-con "Int")))))
+
+(hk-test
+  "sig with tuple and right-assoc ->"
+  (hk-parse-top "pair :: a -> b -> (a, b)")
+  (hk-prog
+    (list
+      :type-sig
+      (list "pair")
+      (list
+        :t-fun
+        (list :t-var "a")
+        (list
+          :t-fun
+          (list :t-var "b")
+          (list
+            :t-tuple
+            (list (list :t-var "a") (list :t-var "b"))))))))
+
+(hk-test
+  "sig + implementation together"
+  (hk-parse-top "id :: a -> a\nid x = x")
+  (hk-prog
+    (list
+      :type-sig
+      (list "id")
+      (list :t-fun (list :t-var "a") (list :t-var "a")))
+    (list
+      :fun-clause
+      "id"
+      (list (list :p-var "x"))
+      (list :var "x"))))
+
+;; ── data declarations ──
+(hk-test
+  "data Maybe"
+  (hk-parse-top "data Maybe a = Nothing | Just a")
+  (hk-prog
+    (list
+      :data
+      "Maybe"
+      (list "a")
+      (list
+        (list :con-def "Nothing" (list))
+        (list :con-def "Just" (list (list :t-var "a")))))))
+
+(hk-test
+  "data Either"
+  (hk-parse-top "data Either a b = Left a | Right b")
+  (hk-prog
+    (list
+      :data
+      "Either"
+      (list "a" "b")
+      (list
+        (list :con-def "Left" (list (list :t-var "a")))
+        (list :con-def "Right" (list (list :t-var "b")))))))
+
+(hk-test
+  "data with no type parameters"
+  (hk-parse-top "data Bool = True | False")
+  (hk-prog
+    (list
+      :data
+      "Bool"
+      (list)
+      (list
+        (list :con-def "True" (list))
+        (list :con-def "False" (list))))))
+
+(hk-test
+  "recursive data type"
+  (hk-parse-top "data Tree a = Leaf | Node (Tree a) a (Tree a)")
+  (hk-prog
+    (list
+      :data
+      "Tree"
+      (list "a")
+      (list
+        (list :con-def "Leaf" (list))
+        (list
+          :con-def
+          "Node"
+          (list
+            (list :t-app (list :t-con "Tree") (list :t-var "a"))
+            (list :t-var "a")
+            (list :t-app (list :t-con "Tree") (list :t-var "a"))))))))
+
+;; ── type synonyms ──
+(hk-test
+  "simple type synonym"
+  (hk-parse-top "type Name = String")
+  (hk-prog
+    (list :type-syn "Name" (list) (list :t-con "String"))))
+
+(hk-test
+  "parameterised type synonym"
+  (hk-parse-top "type Pair a = (a, a)")
+  (hk-prog
+    (list
+      :type-syn
+      "Pair"
+      (list "a")
+      (list
+        :t-tuple
+        (list (list :t-var "a") (list :t-var "a"))))))
+
+;; ── newtype ──
+(hk-test
+  "newtype"
+  (hk-parse-top "newtype Age = Age Int")
+  (hk-prog (list :newtype "Age" (list) "Age" (list :t-con "Int"))))
+
+(hk-test
+  "parameterised newtype"
+  (hk-parse-top "newtype Wrap a = Wrap a")
+  (hk-prog
+    (list :newtype "Wrap" (list "a") "Wrap" (list :t-var "a"))))
+
+;; ── fixity declarations ──
+(hk-test
+  "infixl with precedence"
+  (hk-parse-top "infixl 5 +:, -:")
+  (hk-prog (list :fixity "l" 5 (list "+:" "-:"))))
+
+(hk-test
+  "infixr"
+  (hk-parse-top "infixr 9 .")
+  (hk-prog (list :fixity "r" 9 (list "."))))
+
+(hk-test
+  "infix (non-assoc) default prec"
+  (hk-parse-top "infix ==")
+  (hk-prog (list :fixity "n" 9 (list "=="))))
+
+(hk-test
+  "fixity with backtick operator name"
+  (hk-parse-top "infixl 7 `div`")
+  (hk-prog (list :fixity "l" 7 (list "div"))))
+
+;; ── Several decls combined ──
+(hk-test
+  "mixed: data + sig + fn + type"
+  (hk-parse-top "data Maybe a = Nothing | Just a\ntype Entry = Maybe Int\nf :: Entry -> Int\nf (Just x) = x\nf Nothing = 0")
+  (hk-prog
+    (list
+      :data
+      "Maybe"
+      (list "a")
+      (list
+        (list :con-def "Nothing" (list))
+        (list :con-def "Just" (list (list :t-var "a")))))
+    (list
+      :type-syn
+      "Entry"
+      (list)
+      (list :t-app (list :t-con "Maybe") (list :t-con "Int")))
+    (list
+      :type-sig
+      (list "f")
+      (list :t-fun (list :t-con "Entry") (list :t-con "Int")))
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-con "Just" (list (list :p-var "x"))))
+      (list :var "x"))
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-con "Nothing" (list)))
+      (list :int 0))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-expr.sx

@@ -0,0 +1,258 @@
+;; Haskell expression parser tests.
+;; hk-parse tokenises, runs layout, then parses. Output is an AST
+;; whose head is a keyword tag (evaluates to its string name).
+
+;; ── 1. Literals ──
+(hk-test "integer" (hk-parse "42") (list :int 42))
+(hk-test "float" (hk-parse "3.14") (list :float 3.14))
+(hk-test "string" (hk-parse "\"hi\"") (list :string "hi"))
+(hk-test "char" (hk-parse "'a'") (list :char "a"))
+
+;; ── 2. Variables and constructors ──
+(hk-test "varid" (hk-parse "foo") (list :var "foo"))
+(hk-test "conid" (hk-parse "Nothing") (list :con "Nothing"))
+(hk-test "qvarid" (hk-parse "Data.Map.lookup") (list :var "Data.Map.lookup"))
+(hk-test "qconid" (hk-parse "Data.Map") (list :con "Data.Map"))
+
+;; ── 3. Parens / unit / tuple ──
+(hk-test "parens strip" (hk-parse "(42)") (list :int 42))
+(hk-test "unit" (hk-parse "()") (list :con "()"))
+(hk-test
+  "2-tuple"
+  (hk-parse "(1, 2)")
+  (list :tuple (list (list :int 1) (list :int 2))))
+(hk-test
+  "3-tuple"
+  (hk-parse "(x, y, z)")
+  (list
+    :tuple
+    (list (list :var "x") (list :var "y") (list :var "z"))))
+
+;; ── 4. Lists ──
+(hk-test "empty list" (hk-parse "[]") (list :list (list)))
+(hk-test
+  "singleton list"
+  (hk-parse "[1]")
+  (list :list (list (list :int 1))))
+(hk-test
+  "list of ints"
+  (hk-parse "[1, 2, 3]")
+  (list
+    :list
+    (list (list :int 1) (list :int 2) (list :int 3))))
+(hk-test
+  "range"
+  (hk-parse "[1..10]")
+  (list :range (list :int 1) (list :int 10)))
+(hk-test
+  "range with step"
+  (hk-parse "[1, 3..10]")
+  (list
+    :range-step
+    (list :int 1)
+    (list :int 3)
+    (list :int 10)))
+
+;; ── 5. Application ──
+(hk-test
+  "one-arg app"
+  (hk-parse "f x")
+  (list :app (list :var "f") (list :var "x")))
+(hk-test
+  "multi-arg app is left-assoc"
+  (hk-parse "f x y z")
+  (list
+    :app
+    (list
+      :app
+      (list :app (list :var "f") (list :var "x"))
+      (list :var "y"))
+    (list :var "z")))
+(hk-test
+  "app with con"
+  (hk-parse "Just 5")
+  (list :app (list :con "Just") (list :int 5)))
+
+;; ── 6. Infix operators ──
+(hk-test
+  "simple +"
+  (hk-parse "1 + 2")
+  (list :op "+" (list :int 1) (list :int 2)))
+(hk-test
+  "precedence: * binds tighter than +"
+  (hk-parse "1 + 2 * 3")
+  (list
+    :op
+    "+"
+    (list :int 1)
+    (list :op "*" (list :int 2) (list :int 3))))
+(hk-test
+  "- is left-assoc"
+  (hk-parse "10 - 3 - 2")
+  (list
+    :op
+    "-"
+    (list :op "-" (list :int 10) (list :int 3))
+    (list :int 2)))
+(hk-test
+  ": is right-assoc"
+  (hk-parse "a : b : c")
+  (list
+    :op
+    ":"
+    (list :var "a")
+    (list :op ":" (list :var "b") (list :var "c"))))
+(hk-test
+  "app binds tighter than op"
+  (hk-parse "f x + g y")
+  (list
+    :op
+    "+"
+    (list :app (list :var "f") (list :var "x"))
+    (list :app (list :var "g") (list :var "y"))))
+(hk-test
+  "$ is lowest precedence, right-assoc"
+  (hk-parse "f $ g x")
+  (list
+    :op
+    "$"
+    (list :var "f")
+    (list :app (list :var "g") (list :var "x"))))
+
+;; ── 7. Backticks (varid-as-operator) ──
+(hk-test
+  "backtick operator"
+  (hk-parse "x `mod` 3")
+  (list :op "mod" (list :var "x") (list :int 3)))
+
+;; ── 8. Unary negation ──
+(hk-test
+  "unary -"
+  (hk-parse "- 5")
+  (list :neg (list :int 5)))
+(hk-test
+  "unary - on application"
+  (hk-parse "- f x")
+  (list :neg (list :app (list :var "f") (list :var "x"))))
+(hk-test
+  "- n + m → (- n) + m"
+  (hk-parse "- 1 + 2")
+  (list
+    :op
+    "+"
+    (list :neg (list :int 1))
+    (list :int 2)))
+
+;; ── 9. Lambda ──
+(hk-test
+  "lambda single param"
+  (hk-parse "\\x -> x")
+  (list :lambda (list (list :p-var "x")) (list :var "x")))
+(hk-test
+  "lambda multi-param"
+  (hk-parse "\\x y -> x + y")
+  (list
+    :lambda
+    (list (list :p-var "x") (list :p-var "y"))
+    (list :op "+" (list :var "x") (list :var "y"))))
+(hk-test
+  "lambda body is full expression"
+  (hk-parse "\\f -> f 1 + f 2")
+  (list
+    :lambda
+    (list (list :p-var "f"))
+    (list
+      :op
+      "+"
+      (list :app (list :var "f") (list :int 1))
+      (list :app (list :var "f") (list :int 2)))))
+
+;; ── 10. if-then-else ──
+(hk-test
+  "if basic"
+  (hk-parse "if x then 1 else 2")
+  (list :if (list :var "x") (list :int 1) (list :int 2)))
+(hk-test
+  "if with infix cond"
+  (hk-parse "if x == 0 then y else z")
+  (list
+    :if
+    (list :op "==" (list :var "x") (list :int 0))
+    (list :var "y")
+    (list :var "z")))
+
+;; ── 11. let-in ──
+(hk-test
+  "let single binding"
+  (hk-parse "let x = 1 in x")
+  (list
+    :let
+    (list (list :bind (list :p-var "x") (list :int 1)))
+    (list :var "x")))
+(hk-test
+  "let two bindings (multi-line)"
+  (hk-parse "let x = 1\n    y = 2\nin x + y")
+  (list
+    :let
+    (list
+      (list :bind (list :p-var "x") (list :int 1))
+      (list :bind (list :p-var "y") (list :int 2)))
+    (list :op "+" (list :var "x") (list :var "y"))))
+(hk-test
+  "let with explicit braces"
+  (hk-parse "let { x = 1 ; y = 2 } in x + y")
+  (list
+    :let
+    (list
+      (list :bind (list :p-var "x") (list :int 1))
+      (list :bind (list :p-var "y") (list :int 2)))
+    (list :op "+" (list :var "x") (list :var "y"))))
+
+;; ── 12. Mixed / nesting ──
+(hk-test
+  "nested application"
+  (hk-parse "f (g x) y")
+  (list
+    :app
+    (list
+      :app
+      (list :var "f")
+      (list :app (list :var "g") (list :var "x")))
+    (list :var "y")))
+(hk-test
+  "lambda applied"
+  (hk-parse "(\\x -> x + 1) 5")
+  (list
+    :app
+    (list
+      :lambda
+      (list (list :p-var "x"))
+      (list :op "+" (list :var "x") (list :int 1)))
+    (list :int 5)))
+(hk-test
+  "lambda + if"
+  (hk-parse "\\n -> if n == 0 then 1 else n")
+  (list
+    :lambda
+    (list (list :p-var "n"))
+    (list
+      :if
+      (list :op "==" (list :var "n") (list :int 0))
+      (list :int 1)
+      (list :var "n"))))
+
+;; ── 13. Precedence corners ──
+(hk-test
+  ". is right-assoc (prec 9)"
+  (hk-parse "f . g . h")
+  (list
+    :op
+    "."
+    (list :var "f")
+    (list :op "." (list :var "g") (list :var "h"))))
+(hk-test
+  "== is non-associative (single use)"
+  (hk-parse "x == y")
+  (list :op "==" (list :var "x") (list :var "y")))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-guards-where.sx

@@ -0,0 +1,261 @@
+;; Guards and where-clauses — on fun-clauses, case alts, and
+;; let-bindings (which now also accept funclause-style LHS like
+;; `let f x = e` or `let f x | g = e | g = e`).
+
+(define
+  hk-prog
+  (fn (&rest decls) (list :program decls)))
+
+;; ── Guarded fun-clauses ──
+(hk-test
+  "simple guards (two branches)"
+  (hk-parse-top "abs x | x < 0 = - x\n      | otherwise = x")
+  (hk-prog
+    (list
+      :fun-clause
+      "abs"
+      (list (list :p-var "x"))
+      (list
+        :guarded
+        (list
+          (list
+            :guard
+            (list :op "<" (list :var "x") (list :int 0))
+            (list :neg (list :var "x")))
+          (list :guard (list :var "otherwise") (list :var "x")))))))
+
+(hk-test
+  "three-way guard"
+  (hk-parse-top "sign n | n > 0 = 1\n       | n < 0 = -1\n       | otherwise = 0")
+  (hk-prog
+    (list
+      :fun-clause
+      "sign"
+      (list (list :p-var "n"))
+      (list
+        :guarded
+        (list
+          (list
+            :guard
+            (list :op ">" (list :var "n") (list :int 0))
+            (list :int 1))
+          (list
+            :guard
+            (list :op "<" (list :var "n") (list :int 0))
+            (list :neg (list :int 1)))
+          (list
+            :guard
+            (list :var "otherwise")
+            (list :int 0)))))))
+
+(hk-test
+  "mixed: one eq clause plus one guarded clause"
+  (hk-parse-top "sign 0 = 0\nsign n | n > 0 = 1\n       | otherwise = -1")
+  (hk-prog
+    (list
+      :fun-clause
+      "sign"
+      (list (list :p-int 0))
+      (list :int 0))
+    (list
+      :fun-clause
+      "sign"
+      (list (list :p-var "n"))
+      (list
+        :guarded
+        (list
+          (list
+            :guard
+            (list :op ">" (list :var "n") (list :int 0))
+            (list :int 1))
+          (list
+            :guard
+            (list :var "otherwise")
+            (list :neg (list :int 1))))))))
+
+;; ── where on fun-clauses ──
+(hk-test
+  "where with one binding"
+  (hk-parse-top "f x = y + y\n  where y = x + 1")
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :where
+        (list :op "+" (list :var "y") (list :var "y"))
+        (list
+          (list
+            :fun-clause
+            "y"
+            (list)
+            (list :op "+" (list :var "x") (list :int 1))))))))
+
+(hk-test
+  "where with multiple bindings"
+  (hk-parse-top "f x = y * z\n  where y = x + 1\n        z = x - 1")
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :where
+        (list :op "*" (list :var "y") (list :var "z"))
+        (list
+          (list
+            :fun-clause
+            "y"
+            (list)
+            (list :op "+" (list :var "x") (list :int 1)))
+          (list
+            :fun-clause
+            "z"
+            (list)
+            (list :op "-" (list :var "x") (list :int 1))))))))
+
+(hk-test
+  "guards + where"
+  (hk-parse-top "f x | x > 0 = y\n    | otherwise = 0\n  where y = 99")
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :where
+        (list
+          :guarded
+          (list
+            (list
+              :guard
+              (list :op ">" (list :var "x") (list :int 0))
+              (list :var "y"))
+            (list
+              :guard
+              (list :var "otherwise")
+              (list :int 0))))
+        (list
+          (list :fun-clause "y" (list) (list :int 99)))))))
+
+;; ── Guards in case alts ──
+(hk-test
+  "case alt with guards"
+  (hk-parse "case x of\n  Just y | y > 0 -> y\n         | otherwise -> 0\n  Nothing -> 0")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list :p-con "Just" (list (list :p-var "y")))
+        (list
+          :guarded
+          (list
+            (list
+              :guard
+              (list :op ">" (list :var "y") (list :int 0))
+              (list :var "y"))
+            (list
+              :guard
+              (list :var "otherwise")
+              (list :int 0)))))
+      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
+
+(hk-test
+  "case alt with where"
+  (hk-parse "case x of\n  Just y -> y + z where z = 5\n  Nothing -> 0")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list :p-con "Just" (list (list :p-var "y")))
+        (list
+          :where
+          (list :op "+" (list :var "y") (list :var "z"))
+          (list
+            (list :fun-clause "z" (list) (list :int 5)))))
+      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
+
+;; ── let-bindings: funclause form, guards, where ──
+(hk-test
+  "let with funclause shorthand"
+  (hk-parse "let f x = x + 1 in f 5")
+  (list
+    :let
+    (list
+      (list
+        :fun-clause
+        "f"
+        (list (list :p-var "x"))
+        (list :op "+" (list :var "x") (list :int 1))))
+    (list :app (list :var "f") (list :int 5))))
+
+(hk-test
+  "let with guards"
+  (hk-parse "let f x | x > 0 = x\n        | otherwise = 0\nin f 3")
+  (list
+    :let
+    (list
+      (list
+        :fun-clause
+        "f"
+        (list (list :p-var "x"))
+        (list
+          :guarded
+          (list
+            (list
+              :guard
+              (list :op ">" (list :var "x") (list :int 0))
+              (list :var "x"))
+            (list
+              :guard
+              (list :var "otherwise")
+              (list :int 0))))))
+    (list :app (list :var "f") (list :int 3))))
+
+(hk-test
+  "let funclause + where"
+  (hk-parse "let f x = y where y = x + 1\nin f 7")
+  (list
+    :let
+    (list
+      (list
+        :fun-clause
+        "f"
+        (list (list :p-var "x"))
+        (list
+          :where
+          (list :var "y")
+          (list
+            (list
+              :fun-clause
+              "y"
+              (list)
+              (list :op "+" (list :var "x") (list :int 1)))))))
+    (list :app (list :var "f") (list :int 7))))
+
+;; ── Nested: where inside where (via recursive hk-parse-decl) ──
+(hk-test
+  "where block can contain a type signature"
+  (hk-parse-top "f x = y\n  where y :: Int\n        y = x")
+  (hk-prog
+    (list
+      :fun-clause
+      "f"
+      (list (list :p-var "x"))
+      (list
+        :where
+        (list :var "y")
+        (list
+          (list :type-sig (list "y") (list :t-con "Int"))
+          (list
+            :fun-clause
+            "y"
+            (list)
+            (list :var "x")))))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-module.sx

@@ -0,0 +1,202 @@
+;; Module header + imports. The parser switches from (:program DECLS)
+;; to (:module NAME EXPORTS IMPORTS DECLS) as soon as a module header
+;; or any `import` decl appears.
+
+;; ── Module header ──
+(hk-test
+  "simple module, no exports"
+  (hk-parse-top "module M where\n  f = 1")
+  (list
+    :module
+    "M"
+    nil
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module with dotted name"
+  (hk-parse-top "module Data.Map where\nf = 1")
+  (list
+    :module
+    "Data.Map"
+    nil
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module with empty export list"
+  (hk-parse-top "module M () where\nf = 1")
+  (list
+    :module
+    "M"
+    (list)
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module with exports (var, tycon-all, tycon-with)"
+  (hk-parse-top "module M (f, g, Maybe(..), List(Cons, Nil)) where\nf = 1\ng = 2")
+  (list
+    :module
+    "M"
+    (list
+      (list :ent-var "f")
+      (list :ent-var "g")
+      (list :ent-all "Maybe")
+      (list :ent-with "List" (list "Cons" "Nil")))
+    (list)
+    (list
+      (list :fun-clause "f" (list) (list :int 1))
+      (list :fun-clause "g" (list) (list :int 2)))))
+
+(hk-test
+  "module export list including another module"
+  (hk-parse-top "module M (module Foo, f) where\nf = 1")
+  (list
+    :module
+    "M"
+    (list (list :ent-module "Foo") (list :ent-var "f"))
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "module export with operator"
+  (hk-parse-top "module M ((+:), f) where\nf = 1")
+  (list
+    :module
+    "M"
+    (list (list :ent-var "+:") (list :ent-var "f"))
+    (list)
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "empty module body"
+  (hk-parse-top "module M where")
+  (list :module "M" nil (list) (list)))
+
+;; ── Imports ──
+(hk-test
+  "plain import"
+  (hk-parse-top "import Foo")
+  (list
+    :module
+    nil
+    nil
+    (list (list :import false "Foo" nil nil))
+    (list)))
+
+(hk-test
+  "qualified import"
+  (hk-parse-top "import qualified Data.Map")
+  (list
+    :module
+    nil
+    nil
+    (list (list :import true "Data.Map" nil nil))
+    (list)))
+
+(hk-test
+  "import with alias"
+  (hk-parse-top "import Data.Map as M")
+  (list
+    :module
+    nil
+    nil
+    (list (list :import false "Data.Map" "M" nil))
+    (list)))
+
+(hk-test
+  "import with explicit list"
+  (hk-parse-top "import Foo (bar, Baz(..), Quux(X, Y))")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list
+        :import
+        false
+        "Foo"
+        nil
+        (list
+          :spec-items
+          (list
+            (list :ent-var "bar")
+            (list :ent-all "Baz")
+            (list :ent-with "Quux" (list "X" "Y"))))))
+    (list)))
+
+(hk-test
+  "import hiding"
+  (hk-parse-top "import Foo hiding (x, y)")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list
+        :import
+        false
+        "Foo"
+        nil
+        (list
+          :spec-hiding
+          (list (list :ent-var "x") (list :ent-var "y")))))
+    (list)))
+
+(hk-test
+  "qualified + alias + hiding"
+  (hk-parse-top "import qualified Data.List as L hiding (sort)")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list
+        :import
+        true
+        "Data.List"
+        "L"
+        (list :spec-hiding (list (list :ent-var "sort")))))
+    (list)))
+
+;; ── Combinations ──
+(hk-test
+  "module with multiple imports and a decl"
+  (hk-parse-top "module M where\nimport Foo\nimport qualified Bar as B\nf = 1")
+  (list
+    :module
+    "M"
+    nil
+    (list
+      (list :import false "Foo" nil nil)
+      (list :import true "Bar" "B" nil))
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "headerless file with imports"
+  (hk-parse-top "import Foo\nimport Bar (baz)\nf = 1")
+  (list
+    :module
+    nil
+    nil
+    (list
+      (list :import false "Foo" nil nil)
+      (list
+        :import
+        false
+        "Bar"
+        nil
+        (list :spec-items (list (list :ent-var "baz")))))
+    (list (list :fun-clause "f" (list) (list :int 1)))))
+
+(hk-test
+  "plain program (no header, no imports) still uses :program"
+  (hk-parse-top "f = 1\ng = 2")
+  (list
+    :program
+    (list
+      (list :fun-clause "f" (list) (list :int 1))
+      (list :fun-clause "g" (list) (list :int 2)))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-patterns.sx

@@ -0,0 +1,234 @@
+;; Full-pattern parser tests: as-patterns, lazy ~, negative literals,
+;; infix constructor patterns (`:`, any consym), lambda pattern args,
+;; and let pattern-bindings.
+
+;; ── as-patterns ──
+(hk-test
+  "as pattern, wraps constructor"
+  (hk-parse "case x of n@(Just y) -> n")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list
+          :p-as
+          "n"
+          (list :p-con "Just" (list (list :p-var "y"))))
+        (list :var "n")))))
+
+(hk-test
+  "as pattern, wraps wildcard"
+  (hk-parse "case x of all@_ -> all")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list
+        :alt
+        (list :p-as "all" (list :p-wild))
+        (list :var "all")))))
+
+(hk-test
+  "as in lambda"
+  (hk-parse "\\xs@(a : rest) -> xs")
+  (list
+    :lambda
+    (list
+      (list
+        :p-as
+        "xs"
+        (list
+          :p-con
+          ":"
+          (list (list :p-var "a") (list :p-var "rest")))))
+    (list :var "xs")))
+
+;; ── lazy patterns ──
+(hk-test
+  "lazy var"
+  (hk-parse "case x of ~y -> y")
+  (list
+    :case
+    (list :var "x")
+    (list
+      (list :alt (list :p-lazy (list :p-var "y")) (list :var "y")))))
+
+(hk-test
+  "lazy constructor"
+  (hk-parse "\\(~(Just x)) -> x")
+  (list
+    :lambda
+    (list
+      (list
+        :p-lazy
+        (list :p-con "Just" (list (list :p-var "x")))))
+    (list :var "x")))
+
+;; ── negative literal patterns ──
+(hk-test
+  "negative int pattern"
+  (hk-parse "case n of\n  -1 -> 0\n  _ -> n")
+  (list
+    :case
+    (list :var "n")
+    (list
+      (list :alt (list :p-int -1) (list :int 0))
+      (list :alt (list :p-wild) (list :var "n")))))
+
+(hk-test
+  "negative float pattern"
+  (hk-parse "case x of -0.5 -> 1")
+  (list
+    :case
+    (list :var "x")
+    (list (list :alt (list :p-float -0.5) (list :int 1)))))
+
+;; ── infix constructor patterns (`:` and any consym) ──
+(hk-test
+  "cons pattern"
+  (hk-parse "case xs of x : rest -> x")
+  (list
+    :case
+    (list :var "xs")
+    (list
+      (list
+        :alt
+        (list
+          :p-con
+          ":"
+          (list (list :p-var "x") (list :p-var "rest")))
+        (list :var "x")))))
+
+(hk-test
+  "cons is right-associative in pats"
+  (hk-parse "case xs of a : b : rest -> rest")
+  (list
+    :case
+    (list :var "xs")
+    (list
+      (list
+        :alt
+        (list
+          :p-con
+          ":"
+          (list
+            (list :p-var "a")
+            (list
+              :p-con
+              ":"
+              (list (list :p-var "b") (list :p-var "rest")))))
+        (list :var "rest")))))
+
+(hk-test
+  "consym pattern"
+  (hk-parse "case p of a :+: b -> a")
+  (list
+    :case
+    (list :var "p")
+    (list
+      (list
+        :alt
+        (list
+          :p-con
+          ":+:"
+          (list (list :p-var "a") (list :p-var "b")))
+        (list :var "a")))))
+
+;; ── lambda with pattern args ──
+(hk-test
+  "lambda with constructor pattern"
+  (hk-parse "\\(Just x) -> x")
+  (list
+    :lambda
+    (list (list :p-con "Just" (list (list :p-var "x"))))
+    (list :var "x")))
+
+(hk-test
+  "lambda with tuple pattern"
+  (hk-parse "\\(a, b) -> a + b")
+  (list
+    :lambda
+    (list
+      (list
+        :p-tuple
+        (list (list :p-var "a") (list :p-var "b"))))
+    (list :op "+" (list :var "a") (list :var "b"))))
+
+(hk-test
+  "lambda with wildcard"
+  (hk-parse "\\_ -> 42")
+  (list :lambda (list (list :p-wild)) (list :int 42)))
+
+(hk-test
+  "lambda with mixed apats"
+  (hk-parse "\\x _ (Just y) -> y")
+  (list
+    :lambda
+    (list
+      (list :p-var "x")
+      (list :p-wild)
+      (list :p-con "Just" (list (list :p-var "y"))))
+    (list :var "y")))
+
+;; ── let pattern-bindings ──
+(hk-test
+  "let tuple pattern-binding"
+  (hk-parse "let (x, y) = pair in x + y")
+  (list
+    :let
+    (list
+      (list
+        :bind
+        (list
+          :p-tuple
+          (list (list :p-var "x") (list :p-var "y")))
+        (list :var "pair")))
+    (list :op "+" (list :var "x") (list :var "y"))))
+
+(hk-test
+  "let constructor pattern-binding"
+  (hk-parse "let Just x = m in x")
+  (list
+    :let
+    (list
+      (list
+        :bind
+        (list :p-con "Just" (list (list :p-var "x")))
+        (list :var "m")))
+    (list :var "x")))
+
+(hk-test
+  "let cons pattern-binding"
+  (hk-parse "let (x : rest) = xs in x")
+  (list
+    :let
+    (list
+      (list
+        :bind
+        (list
+          :p-con
+          ":"
+          (list (list :p-var "x") (list :p-var "rest")))
+        (list :var "xs")))
+    (list :var "x")))
+
+;; ── do with constructor-pattern binds ──
+(hk-test
+  "do bind to tuple pattern"
+  (hk-parse "do\n  (a, b) <- pairs\n  return a")
+  (list
+    :do
+    (list
+      (list
+        :do-bind
+        (list
+          :p-tuple
+          (list (list :p-var "a") (list :p-var "b")))
+        (list :var "pairs"))
+      (list
+        :do-expr
+        (list :app (list :var "return") (list :var "a"))))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/parser-sect-comp.sx

@@ -0,0 +1,191 @@
+;; Operator sections and list comprehensions.
+
+;; ── Operator references (unchanged expr shape) ──
+(hk-test
+  "op as value (+)"
+  (hk-parse "(+)")
+  (list :var "+"))
+
+(hk-test
+  "op as value (-)"
+  (hk-parse "(-)")
+  (list :var "-"))
+
+(hk-test
+  "op as value (:)"
+  (hk-parse "(:)")
+  (list :var ":"))
+
+(hk-test
+  "backtick op as value"
+  (hk-parse "(`div`)")
+  (list :var "div"))
+
+;; ── Right sections (op expr) ──
+(hk-test
+  "right section (+ 5)"
+  (hk-parse "(+ 5)")
+  (list :sect-right "+" (list :int 5)))
+
+(hk-test
+  "right section (* x)"
+  (hk-parse "(* x)")
+  (list :sect-right "*" (list :var "x")))
+
+(hk-test
+  "right section with backtick op"
+  (hk-parse "(`div` 2)")
+  (list :sect-right "div" (list :int 2)))
+
+;; `-` is unary in expr position — (- 5) is negation, not a right section
+(hk-test
+  "(- 5) is negation, not a section"
+  (hk-parse "(- 5)")
+  (list :neg (list :int 5)))
+
+;; ── Left sections (expr op) ──
+(hk-test
+  "left section (5 +)"
+  (hk-parse "(5 +)")
+  (list :sect-left "+" (list :int 5)))
+
+(hk-test
+  "left section with backtick"
+  (hk-parse "(x `mod`)")
+  (list :sect-left "mod" (list :var "x")))
+
+(hk-test
+  "left section with cons (x :)"
+  (hk-parse "(x :)")
+  (list :sect-left ":" (list :var "x")))
+
+;; ── Mixed / nesting ──
+(hk-test
+  "map (+ 1) xs"
+  (hk-parse "map (+ 1) xs")
+  (list
+    :app
+    (list
+      :app
+      (list :var "map")
+      (list :sect-right "+" (list :int 1)))
+    (list :var "xs")))
+
+(hk-test
+  "filter (< 0) xs"
+  (hk-parse "filter (< 0) xs")
+  (list
+    :app
+    (list
+      :app
+      (list :var "filter")
+      (list :sect-right "<" (list :int 0)))
+    (list :var "xs")))
+
+;; ── Plain parens and tuples still work ──
+(hk-test
+  "plain parens unwrap"
+  (hk-parse "(1 + 2)")
+  (list :op "+" (list :int 1) (list :int 2)))
+
+(hk-test
+  "tuple still parses"
+  (hk-parse "(a, b, c)")
+  (list
+    :tuple
+    (list (list :var "a") (list :var "b") (list :var "c"))))
+
+;; ── List comprehensions ──
+(hk-test
+  "simple list comprehension"
+  (hk-parse "[x | x <- xs]")
+  (list
+    :list-comp
+    (list :var "x")
+    (list
+      (list :q-gen (list :p-var "x") (list :var "xs")))))
+
+(hk-test
+  "comprehension with filter"
+  (hk-parse "[x * 2 | x <- xs, x > 0]")
+  (list
+    :list-comp
+    (list :op "*" (list :var "x") (list :int 2))
+    (list
+      (list :q-gen (list :p-var "x") (list :var "xs"))
+      (list
+        :q-guard
+        (list :op ">" (list :var "x") (list :int 0))))))
+
+(hk-test
+  "comprehension with let"
+  (hk-parse "[y | x <- xs, let y = x + 1]")
+  (list
+    :list-comp
+    (list :var "y")
+    (list
+      (list :q-gen (list :p-var "x") (list :var "xs"))
+      (list
+        :q-let
+        (list
+          (list
+            :bind
+            (list :p-var "y")
+            (list :op "+" (list :var "x") (list :int 1))))))))
+
+(hk-test
+  "nested generators"
+  (hk-parse "[(x, y) | x <- xs, y <- ys]")
+  (list
+    :list-comp
+    (list :tuple (list (list :var "x") (list :var "y")))
+    (list
+      (list :q-gen (list :p-var "x") (list :var "xs"))
+      (list :q-gen (list :p-var "y") (list :var "ys")))))
+
+(hk-test
+  "comprehension with constructor pattern"
+  (hk-parse "[v | Just v <- xs]")
+  (list
+    :list-comp
+    (list :var "v")
+    (list
+      (list
+        :q-gen
+        (list :p-con "Just" (list (list :p-var "v")))
+        (list :var "xs")))))
+
+(hk-test
+  "comprehension with tuple pattern"
+  (hk-parse "[x + y | (x, y) <- pairs]")
+  (list
+    :list-comp
+    (list :op "+" (list :var "x") (list :var "y"))
+    (list
+      (list
+        :q-gen
+        (list
+          :p-tuple
+          (list (list :p-var "x") (list :p-var "y")))
+        (list :var "pairs")))))
+
+(hk-test
+  "combination: generator, let, guard"
+  (hk-parse "[z | x <- xs, let z = x * 2, z > 10]")
+  (list
+    :list-comp
+    (list :var "z")
+    (list
+      (list :q-gen (list :p-var "x") (list :var "xs"))
+      (list
+        :q-let
+        (list
+          (list
+            :bind
+            (list :p-var "z")
+            (list :op "*" (list :var "x") (list :int 2)))))
+      (list
+        :q-guard
+        (list :op ">" (list :var "z") (list :int 10))))))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/runtime.sx

@@ -0,0 +1,127 @@
+;; Runtime constructor-registry tests. Built-ins are pre-registered
+;; when lib/haskell/runtime.sx loads; user types are registered by
+;; walking a parsed+desugared AST with hk-register-program! (or the
+;; `hk-load-source!` convenience).
+
+;; ── Pre-registered built-ins ──
+(hk-test "True is a con" (hk-is-con? "True") true)
+(hk-test "False is a con" (hk-is-con? "False") true)
+(hk-test "[] is a con" (hk-is-con? "[]") true)
+(hk-test ": (cons) is a con" (hk-is-con? ":") true)
+(hk-test "() is a con" (hk-is-con? "()") true)
+
+(hk-test "True arity 0" (hk-con-arity "True") 0)
+(hk-test ": arity 2" (hk-con-arity ":") 2)
+(hk-test "[] arity 0" (hk-con-arity "[]") 0)
+(hk-test "True type Bool" (hk-con-type "True") "Bool")
+(hk-test "False type Bool" (hk-con-type "False") "Bool")
+(hk-test ": type List" (hk-con-type ":") "List")
+(hk-test "() type Unit" (hk-con-type "()") "Unit")
+
+;; ── Unknown names ──
+(hk-test "is-con? false for varid" (hk-is-con? "foo") false)
+(hk-test "arity nil for unknown" (hk-con-arity "NotACon") nil)
+(hk-test "type nil for unknown" (hk-con-type "NotACon") nil)
+
+;; ── data MyBool = Yes | No ──
+(hk-test
+  "register simple data"
+  (do
+    (hk-load-source! "data MyBool = Yes | No")
+    (list
+      (hk-con-arity "Yes")
+      (hk-con-arity "No")
+      (hk-con-type "Yes")
+      (hk-con-type "No")))
+  (list 0 0 "MyBool" "MyBool"))
+
+;; ── data Maybe a = Nothing | Just a ──
+(hk-test
+  "register Maybe"
+  (do
+    (hk-load-source! "data Maybe a = Nothing | Just a")
+    (list
+      (hk-con-arity "Nothing")
+      (hk-con-arity "Just")
+      (hk-con-type "Nothing")
+      (hk-con-type "Just")))
+  (list 0 1 "Maybe" "Maybe"))
+
+;; ── data Either a b = Left a | Right b ──
+(hk-test
+  "register Either"
+  (do
+    (hk-load-source! "data Either a b = Left a | Right b")
+    (list
+      (hk-con-arity "Left")
+      (hk-con-arity "Right")
+      (hk-con-type "Left")
+      (hk-con-type "Right")))
+  (list 1 1 "Either" "Either"))
+
+;; ── Recursive data ──
+(hk-test
+  "register recursive Tree"
+  (do
+    (hk-load-source!
+      "data Tree a = Leaf | Node (Tree a) a (Tree a)")
+    (list
+      (hk-con-arity "Leaf")
+      (hk-con-arity "Node")
+      (hk-con-type "Leaf")
+      (hk-con-type "Node")))
+  (list 0 3 "Tree" "Tree"))
+
+;; ── newtype ──
+(hk-test
+  "register newtype"
+  (do
+    (hk-load-source! "newtype Age = MkAge Int")
+    (list
+      (hk-con-arity "MkAge")
+      (hk-con-type "MkAge")))
+  (list 1 "Age"))
+
+;; ── Multiple data decls in one program ──
+(hk-test
+  "multiple data decls"
+  (do
+    (hk-load-source!
+      "data Color = Red | Green | Blue\ndata Shape = Circle | Square\nf x = x")
+    (list
+      (hk-con-type "Red")
+      (hk-con-type "Green")
+      (hk-con-type "Blue")
+      (hk-con-type "Circle")
+      (hk-con-type "Square")))
+  (list "Color" "Color" "Color" "Shape" "Shape"))
+
+;; ── Inside a module header ──
+(hk-test
+  "register from module body"
+  (do
+    (hk-load-source!
+      "module M where\ndata Pair a = Pair a a")
+    (list
+      (hk-con-arity "Pair")
+      (hk-con-type "Pair")))
+  (list 2 "Pair"))
+
+;; ── Non-data decls are ignored ──
+(hk-test
+  "program with only fun-decl leaves registry unchanged for that name"
+  (do
+    (hk-load-source! "myFunctionNotACon x = x + 1")
+    (hk-is-con? "myFunctionNotACon"))
+  false)
+
+;; ── Re-registering overwrites (last wins) ──
+(hk-test
+  "re-registration overwrites the entry"
+  (do
+    (hk-load-source! "data Foo = Bar Int")
+    (hk-load-source! "data Foo = Bar Int Int")
+    (hk-con-arity "Bar"))
+  2)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tests/seq.sx

@@ -0,0 +1,85 @@
+;; seq / deepseq tests. seq is strict in its first arg (forces to
+;; WHNF) and returns the second arg unchanged. deepseq additionally
+;; forces the first arg to normal form.
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+(define hk-as-list
+  (fn (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+(define
+  hk-eval-list
+  (fn (src) (hk-as-list (hk-eval-expr-source src))))
+
+;; ── seq returns its second arg ──
+(hk-test
+  "seq with primitive first arg"
+  (hk-eval-expr-source "seq 1 99")
+  99)
+
+(hk-test
+  "seq forces first arg via let"
+  (hk-eval-expr-source "let x = 1 + 2 in seq x x")
+  3)
+
+(hk-test
+  "seq second arg is whatever shape"
+  (hk-eval-expr-source "seq 0 \"hello\"")
+  "hello")
+
+;; ── seq enables previously-lazy bottom to be forced ──
+;; Without seq the let-binding `x = error …` is never forced;
+;; with seq it must be forced because seq is strict in its first
+;; argument. We don't run that error case here (it would terminate
+;; the test), but we do verify the negative — that without seq,
+;; the bottom bound is never demanded.
+(hk-test
+  "lazy let — bottom never forced when unused"
+  (hk-eval-expr-source "let x = error \"never\" in 42")
+  42)
+
+;; ── deepseq forces nested structure ──
+(hk-test
+  "deepseq with finite list"
+  (hk-eval-expr-source "deepseq [1, 2, 3] 7")
+  7)
+
+(hk-test
+  "deepseq with constructor value"
+  (hk-eval-expr-source "deepseq (Just 5) 11")
+  11)
+
+(hk-test
+  "deepseq with tuple"
+  (hk-eval-expr-source "deepseq (1, 2) 13")
+  13)
+
+;; ── seq + arithmetic ──
+(hk-test
+  "seq used inside arithmetic doesn't poison the result"
+  (hk-eval-expr-source "(seq 1 5) + (seq 2 7)")
+  12)
+
+;; ── seq in user code ──
+(hk-test
+  "seq via fun-clause"
+  (hk-prog-val
+    "f x = seq x (x + 1)\nresult = f 10"
+    "result")
+  11)
+
+(hk-test
+  "seq sequences list construction"
+  (hk-eval-list "[seq 1 10, seq 2 20]")
+  (list 10 20))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}

lib/haskell/tokenizer.sx

@@ -0,0 +1,628 @@
+;; Haskell tokenizer — produces a token stream from Haskell 98 source.
+;;
+;; Tokens: {:type T :value V :line L :col C}
+;;
+;; Types:
+;;   "varid"     lowercase ident, e.g. fmap, x, myFunc
+;;   "conid"     uppercase ident, e.g. Nothing, Just, Map
+;;   "qvarid"    qualified varid, value holds raw "A.B.foo"
+;;   "qconid"    qualified conid, e.g. "Data.Map"
+;;   "reserved"  reserved word — value is the word
+;;   "varsym"    operator symbol, e.g. +, ++, >>=
+;;   "consym"    constructor operator (starts with :), e.g. :, :+
+;;   "reservedop" reserved operator ("::", "=", "->", "<-", "=>", "|", "\\", "@", "~", "..")
+;;   "integer"   integer literal (number)
+;;   "float"     float literal (number)
+;;   "char"      char literal (string of length 1)
+;;   "string"    string literal
+;;   "lparen"  "rparen"  "lbracket"  "rbracket"  "lbrace"  "rbrace"
+;;   "vlbrace" "vrbrace" "vsemi"    virtual layout tokens (inserted later)
+;;   "comma"   "semi"    "backtick"
+;;   "newline" a logical line break (used by layout pass; stripped afterwards)
+;;   "eof"
+;;
+;; Note: SX `cond`/`when` clauses evaluate ONLY their last expression.
+;; Multi-expression bodies must be wrapped in (do ...).  All helpers use
+;; the hk- prefix to avoid clashing with SX evaluator special forms.
+
+;; ── Char-code table ───────────────────────────────────────────────
+(define
+  hk-ord-table
+  (let
+    ((t (dict)) (i 0))
+    (define
+      hk-build-table
+      (fn
+        ()
+        (when
+          (< i 128)
+          (do
+            (dict-set! t (char-from-code i) i)
+            (set! i (+ i 1))
+            (hk-build-table)))))
+    (hk-build-table)
+    t))
+
+(define hk-ord (fn (c) (or (get hk-ord-table c) 0)))
+
+;; ── Character predicates ──────────────────────────────────────────
+(define
+  hk-digit?
+  (fn (c) (and (string? c) (>= (hk-ord c) 48) (<= (hk-ord c) 57))))
+
+(define
+  hk-hex-digit?
+  (fn
+    (c)
+    (and
+      (string? c)
+      (or
+        (and (>= (hk-ord c) 48) (<= (hk-ord c) 57))
+        (and (>= (hk-ord c) 97) (<= (hk-ord c) 102))
+        (and (>= (hk-ord c) 65) (<= (hk-ord c) 70))))))
+
+(define
+  hk-octal-digit?
+  (fn (c) (and (string? c) (>= (hk-ord c) 48) (<= (hk-ord c) 55))))
+
+(define
+  hk-lower?
+  (fn
+    (c)
+    (and
+      (string? c)
+      (or (and (>= (hk-ord c) 97) (<= (hk-ord c) 122)) (= c "_")))))
+
+(define
+  hk-upper?
+  (fn (c) (and (string? c) (>= (hk-ord c) 65) (<= (hk-ord c) 90))))
+
+(define hk-alpha? (fn (c) (or (hk-lower? c) (hk-upper? c))))
+
+(define
+  hk-ident-char?
+  (fn (c) (or (hk-alpha? c) (hk-digit? c) (= c "'"))))
+
+(define
+  hk-symbol-char?
+  (fn
+    (c)
+    (or
+      (= c "!")
+      (= c "#")
+      (= c "$")
+      (= c "%")
+      (= c "&")
+      (= c "*")
+      (= c "+")
+      (= c ".")
+      (= c "/")
+      (= c "<")
+      (= c "=")
+      (= c ">")
+      (= c "?")
+      (= c "@")
+      (= c "\\")
+      (= c "^")
+      (= c "|")
+      (= c "-")
+      (= c "~")
+      (= c ":"))))
+
+(define hk-space? (fn (c) (or (= c " ") (= c "\t"))))
+
+;; ── Hex / oct parser (parse-int is decimal only) ──────────────────
+(define
+  hk-parse-radix
+  (fn
+    (s radix)
+    (let
+      ((n-len (len s)) (idx 0) (acc 0))
+      (define
+        hk-rad-loop
+        (fn
+          ()
+          (when
+            (< idx n-len)
+            (do
+              (let
+                ((c (substring s idx (+ idx 1))))
+                (cond
+                  ((and (>= (hk-ord c) 48) (<= (hk-ord c) 57))
+                    (set! acc (+ (* acc radix) (- (hk-ord c) 48))))
+                  ((and (>= (hk-ord c) 97) (<= (hk-ord c) 102))
+                    (set! acc (+ (* acc radix) (+ 10 (- (hk-ord c) 97)))))
+                  ((and (>= (hk-ord c) 65) (<= (hk-ord c) 70))
+                    (set! acc (+ (* acc radix) (+ 10 (- (hk-ord c) 65)))))))
+              (set! idx (+ idx 1))
+              (hk-rad-loop)))))
+      (hk-rad-loop)
+      acc)))
+
+(define
+  hk-parse-float
+  (fn
+    (s)
+    (let
+      ((n-len (len s))
+        (idx 0)
+        (sign 1)
+        (int-part 0)
+        (frac-part 0)
+        (frac-div 1)
+        (exp-sign 1)
+        (exp-val 0)
+        (has-exp false))
+      (when
+        (and (< idx n-len) (= (substring s idx (+ idx 1)) "-"))
+        (do (set! sign -1) (set! idx (+ idx 1))))
+      (when
+        (and (< idx n-len) (= (substring s idx (+ idx 1)) "+"))
+        (set! idx (+ idx 1)))
+      (define
+        hk-int-loop
+        (fn
+          ()
+          (when
+            (and (< idx n-len) (hk-digit? (substring s idx (+ idx 1))))
+            (do
+              (set!
+                int-part
+                (+ (* int-part 10) (parse-int (substring s idx (+ idx 1)))))
+              (set! idx (+ idx 1))
+              (hk-int-loop)))))
+      (hk-int-loop)
+      (when
+        (and (< idx n-len) (= (substring s idx (+ idx 1)) "."))
+        (do
+          (set! idx (+ idx 1))
+          (define
+            hk-frac-loop
+            (fn
+              ()
+              (when
+                (and (< idx n-len) (hk-digit? (substring s idx (+ idx 1))))
+                (do
+                  (set! frac-div (* frac-div 10))
+                  (set!
+                    frac-part
+                    (+
+                      frac-part
+                      (/ (parse-int (substring s idx (+ idx 1))) frac-div)))
+                  (set! idx (+ idx 1))
+                  (hk-frac-loop)))))
+          (hk-frac-loop)))
+      (when
+        (and
+          (< idx n-len)
+          (let
+            ((c (substring s idx (+ idx 1))))
+            (or (= c "e") (= c "E"))))
+        (do
+          (set! has-exp true)
+          (set! idx (+ idx 1))
+          (cond
+            ((and (< idx n-len) (= (substring s idx (+ idx 1)) "-"))
+              (do (set! exp-sign -1) (set! idx (+ idx 1))))
+            ((and (< idx n-len) (= (substring s idx (+ idx 1)) "+"))
+              (set! idx (+ idx 1))))
+          (define
+            hk-exp-loop
+            (fn
+              ()
+              (when
+                (and (< idx n-len) (hk-digit? (substring s idx (+ idx 1))))
+                (do
+                  (set!
+                    exp-val
+                    (+
+                      (* exp-val 10)
+                      (parse-int (substring s idx (+ idx 1)))))
+                  (set! idx (+ idx 1))
+                  (hk-exp-loop)))))
+          (hk-exp-loop)))
+      (let
+        ((base (* sign (+ int-part frac-part))))
+        (if has-exp (* base (pow 10 (* exp-sign exp-val))) base)))))
+
+;; ── Reserved words / ops ──────────────────────────────────────────
+(define
+  hk-reserved-words
+  (list
+    "case"
+    "class"
+    "data"
+    "default"
+    "deriving"
+    "do"
+    "else"
+    "foreign"
+    "if"
+    "import"
+    "in"
+    "infix"
+    "infixl"
+    "infixr"
+    "instance"
+    "let"
+    "module"
+    "newtype"
+    "of"
+    "then"
+    "type"
+    "where"
+    "_"))
+
+(define hk-reserved? (fn (w) (contains? hk-reserved-words w)))
+
+(define
+  hk-reserved-ops
+  (list ".." ":" "::" "=" "\\" "|" "<-" "->" "@" "~" "=>"))
+
+(define hk-reserved-op? (fn (w) (contains? hk-reserved-ops w)))
+
+;; ── Token constructor ─────────────────────────────────────────────
+(define hk-make-token (fn (type value line col) {:line line :value value :col col :type type}))
+
+;; ── Main tokenizer ────────────────────────────────────────────────
+(define
+  hk-tokenize
+  (fn
+    (src)
+    (let
+      ((tokens (list)) (pos 0) (line 1) (col 1) (src-len (len src)))
+      (define
+        hk-peek
+        (fn
+          (offset)
+          (if
+            (< (+ pos offset) src-len)
+            (substring src (+ pos offset) (+ pos offset 1))
+            nil)))
+      (define hk-cur (fn () (hk-peek 0)))
+      (define
+        hk-advance!
+        (fn
+          ()
+          (let
+            ((c (hk-cur)))
+            (set! pos (+ pos 1))
+            (if
+              (= c "\n")
+              (do (set! line (+ line 1)) (set! col 1))
+              (set! col (+ col 1))))))
+      (define
+        hk-advance-n!
+        (fn
+          (n)
+          (when (> n 0) (do (hk-advance!) (hk-advance-n! (- n 1))))))
+      (define
+        hk-push!
+        (fn
+          (type value tok-line tok-col)
+          (append! tokens (hk-make-token type value tok-line tok-col))))
+      (define
+        hk-read-while
+        (fn
+          (pred)
+          (let
+            ((start pos))
+            (define
+              hk-rw-loop
+              (fn
+                ()
+                (when
+                  (and (< pos src-len) (pred (hk-cur)))
+                  (do (hk-advance!) (hk-rw-loop)))))
+            (hk-rw-loop)
+            (substring src start pos))))
+      (define
+        hk-skip-line-comment!
+        (fn
+          ()
+          (define
+            hk-slc-loop
+            (fn
+              ()
+              (when
+                (and (< pos src-len) (not (= (hk-cur) "\n")))
+                (do (hk-advance!) (hk-slc-loop)))))
+          (hk-slc-loop)))
+      (define
+        hk-skip-block-comment!
+        (fn
+          ()
+          (hk-advance-n! 2)
+          (let
+            ((depth 1))
+            (define
+              hk-sbc-loop
+              (fn
+                ()
+                (cond
+                  ((>= pos src-len) nil)
+                  ((and (= (hk-cur) "{") (= (hk-peek 1) "-"))
+                    (do
+                      (hk-advance-n! 2)
+                      (set! depth (+ depth 1))
+                      (hk-sbc-loop)))
+                  ((and (= (hk-cur) "-") (= (hk-peek 1) "}"))
+                    (do
+                      (hk-advance-n! 2)
+                      (set! depth (- depth 1))
+                      (when (> depth 0) (hk-sbc-loop))))
+                  (:else (do (hk-advance!) (hk-sbc-loop))))))
+            (hk-sbc-loop))))
+      (define
+        hk-read-escape
+        (fn
+          ()
+          (hk-advance!)
+          (let
+            ((c (hk-cur)))
+            (cond
+              ((= c "n") (do (hk-advance!) "\n"))
+              ((= c "t") (do (hk-advance!) "\t"))
+              ((= c "r") (do (hk-advance!) "\r"))
+              ((= c "\\") (do (hk-advance!) "\\"))
+              ((= c "'") (do (hk-advance!) "'"))
+              ((= c "\"") (do (hk-advance!) "\""))
+              ((= c "0") (do (hk-advance!) (char-from-code 0)))
+              ((= c "a") (do (hk-advance!) (char-from-code 7)))
+              ((= c "b") (do (hk-advance!) (char-from-code 8)))
+              ((= c "f") (do (hk-advance!) (char-from-code 12)))
+              ((= c "v") (do (hk-advance!) (char-from-code 11)))
+              ((hk-digit? c)
+                (let
+                  ((digits (hk-read-while hk-digit?)))
+                  (char-from-code (parse-int digits))))
+              (:else (do (hk-advance!) (str "\\" c)))))))
+      (define
+        hk-read-string
+        (fn
+          ()
+          (let
+            ((parts (list)))
+            (hk-advance!)
+            (define
+              hk-rs-loop
+              (fn
+                ()
+                (cond
+                  ((>= pos src-len) nil)
+                  ((= (hk-cur) "\"") (hk-advance!))
+                  ((= (hk-cur) "\\")
+                    (do (append! parts (hk-read-escape)) (hk-rs-loop)))
+                  (:else
+                    (do
+                      (append! parts (hk-cur))
+                      (hk-advance!)
+                      (hk-rs-loop))))))
+            (hk-rs-loop)
+            (join "" parts))))
+      (define
+        hk-read-char-lit
+        (fn
+          ()
+          (hk-advance!)
+          (let
+            ((c (if (= (hk-cur) "\\") (hk-read-escape) (let ((ch (hk-cur))) (hk-advance!) ch))))
+            (when (= (hk-cur) "'") (hk-advance!))
+            c)))
+      (define
+        hk-read-number
+        (fn
+          (tok-line tok-col)
+          (let
+            ((start pos))
+            (cond
+              ((and (= (hk-cur) "0") (or (= (hk-peek 1) "x") (= (hk-peek 1) "X")))
+                (do
+                  (hk-advance-n! 2)
+                  (let
+                    ((hex-start pos))
+                    (hk-read-while hk-hex-digit?)
+                    (hk-push!
+                      "integer"
+                      (hk-parse-radix (substring src hex-start pos) 16)
+                      tok-line
+                      tok-col))))
+              ((and (= (hk-cur) "0") (or (= (hk-peek 1) "o") (= (hk-peek 1) "O")))
+                (do
+                  (hk-advance-n! 2)
+                  (let
+                    ((oct-start pos))
+                    (hk-read-while hk-octal-digit?)
+                    (hk-push!
+                      "integer"
+                      (hk-parse-radix (substring src oct-start pos) 8)
+                      tok-line
+                      tok-col))))
+              (:else
+                (do
+                  (hk-read-while hk-digit?)
+                  (let
+                    ((is-float false))
+                    (when
+                      (and (= (hk-cur) ".") (hk-digit? (hk-peek 1)))
+                      (do
+                        (set! is-float true)
+                        (hk-advance!)
+                        (hk-read-while hk-digit?)))
+                    (when
+                      (or (= (hk-cur) "e") (= (hk-cur) "E"))
+                      (do
+                        (set! is-float true)
+                        (hk-advance!)
+                        (when
+                          (or (= (hk-cur) "+") (= (hk-cur) "-"))
+                          (hk-advance!))
+                        (hk-read-while hk-digit?)))
+                    (let
+                      ((num-str (substring src start pos)))
+                      (if
+                        is-float
+                        (hk-push!
+                          "float"
+                          (hk-parse-float num-str)
+                          tok-line
+                          tok-col)
+                        (hk-push!
+                          "integer"
+                          (parse-int num-str)
+                          tok-line
+                          tok-col))))))))))
+      (define
+        hk-read-qualified!
+        (fn
+          (tok-line tok-col)
+          (let
+            ((parts (list)) (w (hk-read-while hk-ident-char?)))
+            (append! parts w)
+            (let
+              ((emitted false))
+              (define
+                hk-rq-loop
+                (fn
+                  ()
+                  (when
+                    (and
+                      (not emitted)
+                      (= (hk-cur) ".")
+                      (or
+                        (hk-upper? (hk-peek 1))
+                        (hk-lower? (hk-peek 1))
+                        (hk-symbol-char? (hk-peek 1))))
+                    (let
+                      ((next (hk-peek 1)))
+                      (cond
+                        ((hk-upper? next)
+                          (do
+                            (hk-advance!)
+                            (append! parts ".")
+                            (append! parts (hk-read-while hk-ident-char?))
+                            (hk-rq-loop)))
+                        ((hk-lower? next)
+                          (do
+                            (hk-advance!)
+                            (set! emitted true)
+                            (hk-push!
+                              "qvarid"
+                              (str
+                                (join "" parts)
+                                "."
+                                (hk-read-while hk-ident-char?))
+                              tok-line
+                              tok-col)))
+                        ((hk-symbol-char? next)
+                          (do
+                            (hk-advance!)
+                            (set! emitted true)
+                            (hk-push!
+                              "varsym"
+                              (str
+                                (join "" parts)
+                                "."
+                                (hk-read-while hk-symbol-char?))
+                              tok-line
+                              tok-col))))))))
+              (hk-rq-loop)
+              (when
+                (not emitted)
+                (let
+                  ((full (join "" parts)))
+                  (if
+                    (string-contains? full ".")
+                    (hk-push! "qconid" full tok-line tok-col)
+                    (hk-push! "conid" full tok-line tok-col))))))))
+      (define
+        hk-scan!
+        (fn
+          ()
+          (cond
+            ((>= pos src-len) nil)
+            ((hk-space? (hk-cur)) (do (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) "\n")
+              (do
+                (let
+                  ((l line) (c col))
+                  (hk-advance!)
+                  (hk-push! "newline" nil l c))
+                (hk-scan!)))
+            ((and (= (hk-cur) "{") (= (hk-peek 1) "-"))
+              (do (hk-skip-block-comment!) (hk-scan!)))
+            ((and (= (hk-cur) "-") (= (hk-peek 1) "-") (let ((p2 (hk-peek 2))) (or (nil? p2) (= p2 "\n") (not (hk-symbol-char? p2)))))
+              (do (hk-skip-line-comment!) (hk-scan!)))
+            ((= (hk-cur) "\"")
+              (do
+                (let
+                  ((l line) (c col))
+                  (hk-push! "string" (hk-read-string) l c))
+                (hk-scan!)))
+            ((= (hk-cur) "'")
+              (do
+                (let
+                  ((l line) (c col))
+                  (hk-push! "char" (hk-read-char-lit) l c))
+                (hk-scan!)))
+            ((hk-digit? (hk-cur))
+              (do (hk-read-number line col) (hk-scan!)))
+            ((hk-lower? (hk-cur))
+              (do
+                (let
+                  ((l line) (c col))
+                  (let
+                    ((w (hk-read-while hk-ident-char?)))
+                    (if
+                      (hk-reserved? w)
+                      (hk-push! "reserved" w l c)
+                      (hk-push! "varid" w l c))))
+                (hk-scan!)))
+            ((hk-upper? (hk-cur))
+              (do
+                (let ((l line) (c col)) (hk-read-qualified! l c))
+                (hk-scan!)))
+            ((= (hk-cur) "(")
+              (do (hk-push! "lparen" "(" line col) (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) ")")
+              (do (hk-push! "rparen" ")" line col) (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) "[")
+              (do
+                (hk-push! "lbracket" "[" line col)
+                (hk-advance!)
+                (hk-scan!)))
+            ((= (hk-cur) "]")
+              (do
+                (hk-push! "rbracket" "]" line col)
+                (hk-advance!)
+                (hk-scan!)))
+            ((= (hk-cur) "{")
+              (do (hk-push! "lbrace" "{" line col) (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) "}")
+              (do (hk-push! "rbrace" "}" line col) (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) ",")
+              (do (hk-push! "comma" "," line col) (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) ";")
+              (do (hk-push! "semi" ";" line col) (hk-advance!) (hk-scan!)))
+            ((= (hk-cur) "`")
+              (do
+                (hk-push! "backtick" "`" line col)
+                (hk-advance!)
+                (hk-scan!)))
+            ((hk-symbol-char? (hk-cur))
+              (do
+                (let
+                  ((l line) (c col))
+                  (let
+                    ((first (hk-cur)))
+                    (let
+                      ((w (hk-read-while hk-symbol-char?)))
+                      (cond
+                        ((hk-reserved-op? w) (hk-push! "reservedop" w l c))
+                        ((= first ":") (hk-push! "consym" w l c))
+                        (:else (hk-push! "varsym" w l c))))))
+                (hk-scan!)))
+            (:else (do (hk-advance!) (hk-scan!))))))
+      (hk-scan!)
+      (hk-push! "eof" nil line col)
+      tokens)))

lib/hyperscript/debug.sx

@@ -0,0 +1,38 @@
+;; Hyperscript debug harness — mock DOM for instant testing
+;;
+;; Load once into the image, then repeatedly call hs-run.
+;; All DOM ops are intercepted and logged via the test harness.
+
+;; ── Mock element ────────────────────────────────────────────────
+
+(define
+  hs-mock-element
+  (fn
+    (tag id classes)
+    (let
+      ((cls-set (reduce (fn (d c) (dict-set d c true)) {} classes)))
+      {:children () :_hs-activated true :tag tag :classes cls-set :text "" :id id :attrs {}})))
+
+;; ── Mock platform ───────────────────────────────────────────────
+
+(define hs-mock-platform {:hs-wait (fn (ms) nil) :hs-wait-for (fn (target event) nil) :dom-get-attr (fn (el attr) (get (get el "attrs") attr)) :dom-has-class? (fn (el cls) (dict-has? (get el "classes") cls)) :dom-set-text (fn (el text) (dict-set! el "text" text) nil) :hs-settle (fn (el) nil) :dom-add-class (fn (el cls) (dict-set! (get el "classes") cls true) nil) :dom-query (fn (sel) nil) :dom-remove-class (fn (el cls) (dict-delete! (get el "classes") cls) nil) :dom-listen (fn (target event-name handler) (handler {:target target :type event-name})) :dom-set-attr (fn (el attr val) (dict-set! (get el "attrs") attr val) nil) :dom-query-all (fn (sel) ())})
+
+;; ── Convenience runner ──────────────────────────────────────────
+
+(define
+  hs-run
+  (fn
+    (src)
+    (let
+      ((me (hs-mock-element "div" "test" ()))
+        (sx (hs-to-sx-from-source src)))
+      (let
+        ((handler (eval-expr (list (quote fn) (quote (me)) (list (quote let) (quote ((it nil) (event {:target me :type "click"}))) sx)))))
+        (handler me)
+        me))))
+
+;; ── Element inspection ──────────────────────────────────────────
+
+(define hs-classes (fn (el) (keys (get el "classes"))))
+
+(define hs-has-class? (fn (el cls) (dict-has? (get el "classes") cls)))

lib/hyperscript/integration.sx

@@ -10,12 +10,55 @@
 ;; Returns a function (fn (me) ...) that can be called with a DOM element.
 ;; Uses eval-expr-cek to turn the SX data structure into a live closure.
 
-(define
+(begin
+  (define
+    hs-collect-vars
+    (fn
+      (sx)
+      (define vars (list))
+      (define
+        reserved
+        (list
+          (quote me)
+          (quote it)
+          (quote event)
+          (quote you)
+          (quote yourself)))
+      (define
+        walk
+        (fn
+          (node)
+          (when
+            (list? node)
+            (when
+              (and
+                (> (len node) 1)
+                (= (first node) (quote set!))
+                (symbol? (nth node 1)))
+              (let
+                ((name (nth node 1)))
+                (when
+                  (and
+                    (not (some (fn (v) (= v name)) vars))
+                    (not (some (fn (v) (= v name)) reserved)))
+                  (set! vars (cons name vars)))))
+            (for-each walk node))))
+      (walk sx)
+      vars))
+  (define
     hs-handler
     (fn
       (src)
       (let
         ((sx (hs-to-sx-from-source src)))
+        (let
+          ((extra-vars (hs-collect-vars sx)))
+          (do
+            (for-each
+              (fn (v) (eval-expr-cek (list (quote define) v nil)))
+              extra-vars)
+            (let
+              ((guarded (list (quote guard) (list (quote _e) (list (quote true) (list (quote if) (list (quote and) (list (quote list?) (quote _e)) (list (quote =) (list (quote first) (quote _e)) "hs-return")) (list (quote nth) (quote _e) 1) (list (quote raise) (quote _e))))) sx)))
               (eval-expr-cek
                 (list
                   (quote fn)
@@ -23,7 +66,7 @@
                   (list
                     (quote let)
                     (list (list (quote it) nil) (list (quote event) nil))
-            sx))))))
+                    guarded))))))))))
 
 ;; ── Activate a single element ───────────────────────────────────
 ;; Reads the _="..." attribute, compiles, and executes with me=element.
@@ -34,10 +77,13 @@
   (fn
     (el)
     (let
-      ((src (dom-get-attr el "_")))
+      ((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
       (when
-        (and src (not (dom-get-data el "hs-active")))
+        (and src (not (= src prev)))
+        (hs-log-event! "hyperscript:init")
+        (dom-set-data el "hs-script" src)
         (dom-set-data el "hs-active" true)
+        (dom-set-attr el "data-hyperscript-powered" "true")
         (let ((handler (hs-handler src))) (handler el))))))
 
 ;; ── Boot: scan entire document ──────────────────────────────────
@@ -45,17 +91,28 @@
 ;; compiles their hyperscript, and activates them.
 
 (define
-  hs-boot!
+  hs-deactivate!
   (fn
-    ()
+    (el)
     (let
-      ((elements (dom-query-all (dom-body) "[_]")))
-      (for-each (fn (el) (hs-activate! el)) elements))))
+      ((unlisteners (or (dom-get-data el "hs-unlisteners") (list))))
+      (for-each (fn (u) (when u (u))) unlisteners)
+      (dom-set-data el "hs-unlisteners" (list))
+      (dom-set-data el "hs-active" false)
+      (dom-set-data el "hs-script" nil))))
 
 ;; ── Boot subtree: for dynamic content ───────────────────────────
 ;; Called after HTMX swaps or dynamic DOM insertion.
 ;; Only activates elements within the given root.
 
+(define
+  hs-boot!
+  (fn
+    ()
+    (let
+      ((elements (dom-query-all (host-get (host-global "document") "body") "[_]")))
+      (for-each (fn (el) (hs-activate! el)) elements))))
+
 (define
   hs-boot-subtree!
   (fn

lib/hyperscript/test-closure.sx

@@ -0,0 +1,13 @@
+;; Minimal test: define-inside-let pattern (like hs-parse)
+(define
+  test-closure-parse
+  (fn
+    (tokens)
+    (let
+      ((p 0) (tok-len (len tokens)))
+      (define get-val (fn () (get (nth tokens p) "value")))
+      (define advance! (fn () (set! p (+ p 1))))
+      (let
+        ((first-val (get-val)))
+        (advance!)
+        (list "first:" first-val "second:" (get-val) "p:" p)))))

lib/hyperscript/test.sh

@@ -0,0 +1,156 @@
+#!/usr/bin/env bash
+# Fast hyperscript test runner — pipes directly to sx_server.exe via epoch protocol.
+# No MCP, no Docker, no web server. Runs in <2 seconds.
+#
+# Usage:
+#   bash lib/hyperscript/test.sh           # run all tests
+#   bash lib/hyperscript/test.sh -v        # verbose — show actual output
+
+set -euo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: $SX_SERVER not found. Run: cd hosts/ocaml && dune build"
+  exit 1
+fi
+
+VERBOSE="${1:-}"
+PASS=0
+FAIL=0
+ERRORS=""
+TMPFILE=$(mktemp)
+trap "rm -f $TMPFILE" EXIT
+
+# ── Write epoch commands to temp file ─────────────────────────────
+cat > "$TMPFILE" << 'EPOCHS'
+(epoch 1)
+(load "lib/r7rs.sx")
+(epoch 2)
+(load "lib/hyperscript/tokenizer.sx")
+(epoch 3)
+(load "lib/hyperscript/parser.sx")
+(epoch 4)
+(load "lib/hyperscript/compiler.sx")
+(epoch 10)
+(eval "(hs-compile \"on click add .red to me\")")
+(epoch 11)
+(eval "(hs-compile \"on click toggle .active on me\")")
+(epoch 12)
+(eval "(hs-compile \"on click add .red to me then remove .blue from me\")")
+(epoch 13)
+(eval "(hs-compile \"on click set my innerHTML to 'hello'\")")
+(epoch 14)
+(eval "(hs-compile \"on click log me\")")
+(epoch 15)
+(eval "(hs-compile \"add .highlight to me\")")
+(epoch 16)
+(eval "(hs-compile \"remove .highlight from me\")")
+(epoch 17)
+(eval "(hs-compile \"toggle .visible on me\")")
+(epoch 18)
+(eval "(hs-compile \"hide me\")")
+(epoch 19)
+(eval "(hs-compile \"show me\")")
+(epoch 20)
+(eval "(hs-compile \"wait 500ms\")")
+(epoch 21)
+(eval "(hs-compile \"wait 2s\")")
+(epoch 22)
+(eval "(hs-compile \"set x to 1 + 2\")")
+(epoch 23)
+(eval "(hs-compile \"set x to 3 * 4\")")
+(epoch 24)
+(eval "(hs-compile \"init add .loaded to me end\")")
+(epoch 25)
+(eval "(hs-compile \"set x to 42\")")
+(epoch 26)
+(eval "(hs-compile \"put 'hello' into me\")")
+(epoch 27)
+(eval "(hs-compile \"increment x\")")
+(epoch 28)
+(eval "(hs-compile \"decrement x\")")
+(epoch 29)
+(eval "(hs-compile \"on every click log me end\")")
+(epoch 30)
+(eval "(hs-compile \"on click from .btn log me end\")")
+(epoch 40)
+(eval "(hs-to-sx-from-source \"on click add .red to me\")")
+(epoch 41)
+(eval "(hs-to-sx-from-source \"on click toggle .active on me\")")
+(epoch 42)
+(eval "(hs-to-sx-from-source \"on click set my innerHTML to 'hello'\")")
+(epoch 43)
+(eval "(hs-to-sx-from-source \"on click add .red to me then remove .blue from me\")")
+EPOCHS
+
+# ── Run ───────────────────────────────────────────────────────────
+OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
+
+# ── Check function ────────────────────────────────────────────────
+check() {
+  local epoch="$1" desc="$2" expected="$3"
+  local actual
+  actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1)
+  if [ -z "$actual" ]; then
+    actual=$(echo "$OUTPUT" | grep "^(ok $epoch " || true)
+  fi
+  if [ -z "$actual" ]; then
+    actual=$(echo "$OUTPUT" | grep "^(error $epoch " || true)
+  fi
+  if [ -z "$actual" ]; then
+    actual="<no output for epoch $epoch>"
+  fi
+
+  if echo "$actual" | grep -qF "$expected"; then
+    PASS=$((PASS + 1))
+    [ "$VERBOSE" = "-v" ] && echo "  ✓ $desc"
+  else
+    FAIL=$((FAIL + 1))
+    ERRORS+="  ✗ $desc (epoch $epoch)
+    expected: $expected
+    actual:   $actual
+"
+  fi
+}
+
+# ── Parser assertions ─────────────────────────────────────────────
+check 10 "on click basic"         '(on "click" (add-class "red" (me)))'
+check 11 "on click toggle"        '(on "click" (toggle-class "active" (me)))'
+check 12 "on click chain"         '(on "click" (do (add-class "red" (me)) (remove-class "blue" (me))))'
+check 13 "on click set prop"      '(on "click" (set!'
+check 14 "on click log"           '(on "click" (log (me)))'
+check 15 "add class cmd"          '(add-class "highlight" (me))'
+check 16 "remove class cmd"       '(remove-class "highlight" (me))'
+check 17 "toggle class cmd"       '(toggle-class "visible" (me))'
+check 18 "hide cmd"               '(hide (me))'
+check 19 "show cmd"               '(show (me))'
+check 20 "wait ms"                '(wait 500)'
+check 21 "wait seconds"           '(wait 2000)'
+check 22 "arithmetic add"         '+'
+check 23 "arithmetic mul"         '*'
+check 24 "init feature"           '(init'
+check 25 "set variable"           '(set! (ref "x") 42)'
+check 26 "put into"               '(set! (me) "hello")'
+check 27 "increment"              'increment'
+check 28 "decrement"              'decrement'
+check 29 "on every click"         '(on'
+check 30 "on click from"          '(on'
+
+# ── Compiler assertions ───────────────────────────────────────────
+check 40 "compiled: on click"     '(hs-on me "click"'
+check 41 "compiled: toggle"       'hs-toggle-class!'
+check 42 "compiled: set prop"     'dom-set-prop'
+check 43 "compiled: chain"        'dom-remove-class'
+
+# ── Report ────────────────────────────────────────────────────────
+TOTAL=$((PASS + FAIL))
+if [ $FAIL -eq 0 ]; then
+  echo "✓ $PASS/$TOTAL hyperscript tests passed"
+else
+  echo "✗ $PASS/$TOTAL passed, $FAIL failed:"
+  echo ""
+  echo "$ERRORS"
+fi
+
+[ $FAIL -eq 0 ]

lib/hyperscript/tokenizer.sx

@@ -104,6 +104,7 @@
     "detail"
     "sender"
     "index"
+    "indexed"
     "increment"
     "decrement"
     "append"
@@ -116,7 +117,12 @@
     "first"
     "last"
     "random"
+    "pick"
     "empty"
+    "clear"
+    "swap"
+    "open"
+    "close"
     "exists"
     "matches"
     "contains"
@@ -139,7 +145,49 @@
     "behavior"
     "called"
     "render"
-    "eval"))
+    "eval"
+    "I"
+    "am"
+    "does"
+    "some"
+    "mod"
+    "equal"
+    "equals"
+    "really"
+    "include"
+    "includes"
+    "contain"
+    "undefined"
+    "exist"
+    "match"
+    "beep"
+    "where"
+    "sorted"
+    "mapped"
+    "split"
+    "joined"
+    "descending"
+    "ascending"
+    "scroll"
+    "select"
+    "reset"
+    "default"
+    "halt"
+    "precedes"
+    "precede"
+    "follow"
+    "follows"
+    "ignoring"
+    "case"
+    "changes"
+    "focus"
+    "blur"
+    "dom"
+    "morph"
+    "using"
+    "giving"
+    "ask"
+    "answer"))
 
 (define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
 
@@ -207,6 +255,32 @@
                   (hs-advance! 1)
                   (read-frac))))
             (read-frac))
+          (do
+            (when
+              (and
+                (< pos src-len)
+                (or (= (hs-cur) "e") (= (hs-cur) "E"))
+                (or
+                  (and (< (+ pos 1) src-len) (hs-digit? (hs-peek 1)))
+                  (and
+                    (< (+ pos 2) src-len)
+                    (or (= (hs-peek 1) "+") (= (hs-peek 1) "-"))
+                    (hs-digit? (hs-peek 2)))))
+              (hs-advance! 1)
+              (when
+                (and
+                  (< pos src-len)
+                  (or (= (hs-cur) "+") (= (hs-cur) "-")))
+                (hs-advance! 1))
+              (define
+                read-exp-digits
+                (fn
+                  ()
+                  (when
+                    (and (< pos src-len) (hs-digit? (hs-cur)))
+                    (hs-advance! 1)
+                    (read-exp-digits))))
+              (read-exp-digits))
             (let
               ((num-end pos))
               (when
@@ -220,7 +294,7 @@
                     (= (hs-peek 1) "s"))
                   (hs-advance! 2)
                   (when (= (hs-cur) "s") (hs-advance! 1))))
-            (slice src start pos))))
+              (slice src start pos)))))
       (define
         read-string
         (fn
@@ -345,12 +419,8 @@
               (or
                 (hs-ident-char? (hs-cur))
                 (= (hs-cur) ":")
-                (= (hs-cur) "\\")
                 (= (hs-cur) "[")
-                (= (hs-cur) "]")
-                (= (hs-cur) "(")
-                (= (hs-cur) ")")))
-            (when (= (hs-cur) "\\") (hs-advance! 1))
+                (= (hs-cur) "]")))
             (hs-advance! 1)
             (read-class-name start))
           (slice src start pos)))
@@ -369,6 +439,8 @@
             (let
               ((ch (hs-cur)) (start pos))
               (cond
+                (and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
+                (do (hs-advance! 2) (skip-comment!) (scan!))
                 (and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
                 (do (hs-advance! 2) (skip-comment!) (scan!))
                 (and
@@ -383,6 +455,8 @@
                     (= (hs-peek 1) "*")
                     (= (hs-peek 1) ":")))
                 (do (hs-emit! "selector" (read-selector) start) (scan!))
+                (and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
+                (do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
                 (and
                   (= ch ".")
                   (< (+ pos 1) src-len)
@@ -410,6 +484,14 @@
                   (hs-advance! 1)
                   (hs-emit! "attr" (read-ident pos) start)
                   (scan!))
+                (and
+                  (= ch "^")
+                  (< (+ pos 1) src-len)
+                  (hs-ident-char? (hs-peek 1)))
+                (do
+                  (hs-advance! 1)
+                  (hs-emit! "hat" (read-ident pos) start)
+                  (scan!))
                 (and
                   (= ch "~")
                   (< (+ pos 1) src-len)
@@ -464,8 +546,13 @@
                   (< (+ pos 1) src-len)
                   (= (hs-peek 1) "="))
                 (do
-                  (hs-emit! "op" (str ch "=") start)
-                  (hs-advance! 2)
+                  (if
+                    (and
+                      (or (= ch "=") (= ch "!"))
+                      (< (+ pos 2) src-len)
+                      (= (hs-peek 2) "="))
+                    (do (hs-emit! "op" (str ch "==") start) (hs-advance! 3))
+                    (do (hs-emit! "op" (str ch "=") start) (hs-advance! 2)))
                   (scan!))
                 (and
                   (= ch "'")
@@ -527,6 +614,12 @@
                 (do (hs-emit! "op" "%" start) (hs-advance! 1) (scan!))
                 (= ch ".")
                 (do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
+                (= ch "\\")
+                (do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
+                (= ch ":")
+                (do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
+                (= ch "|")
+                (do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
                 :else (do (hs-advance! 1) (scan!)))))))
       (scan!)
       (hs-emit! "eof" nil pos)

lib/js/.gitignore

@@ -0,0 +1,2 @@
+test262-upstream/
+.harness-cache/

lib/js/conformance.sh

@@ -0,0 +1,130 @@
+#!/usr/bin/env bash
+# Cherry-picked test262 conformance runner for JS-on-SX.
+# Walks lib/js/test262-slice/**/*.js, evaluates each via js-eval,
+# and compares against the sibling .expected file (substring match).
+#
+# Usage:
+#   bash lib/js/conformance.sh          # summary only
+#   bash lib/js/conformance.sh -v       # per-test pass/fail
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: $SX_SERVER not found. Run: cd hosts/ocaml && dune build"
+  exit 1
+fi
+
+VERBOSE="${1:-}"
+SLICE_DIR="lib/js/test262-slice"
+PASS=0
+FAIL=0
+ERRORS=""
+
+# Find all .js fixtures (sorted for stable output).
+# Skip README.md and similar.
+mapfile -t FIXTURES < <(find "$SLICE_DIR" -type f -name '*.js' | sort)
+
+if [ ${#FIXTURES[@]} -eq 0 ]; then
+  echo "No fixtures found in $SLICE_DIR"
+  exit 1
+fi
+
+# Build one big batch script: load everything once, then one epoch per
+# fixture. Avoids the ~200ms boot cost of starting the server for each
+# test.
+
+TMPFILE=$(mktemp)
+trap "rm -f $TMPFILE" EXIT
+
+{
+  echo '(epoch 1)'
+  echo '(load "lib/r7rs.sx")'
+  echo '(epoch 2)'
+  echo '(load "lib/js/lexer.sx")'
+  echo '(epoch 3)'
+  echo '(load "lib/js/parser.sx")'
+  echo '(epoch 4)'
+  echo '(load "lib/js/transpile.sx")'
+  echo '(epoch 5)'
+  echo '(load "lib/js/runtime.sx")'
+
+  epoch=100
+  for f in "${FIXTURES[@]}"; do
+    # Read source, strip trailing newline, then escape for *two*
+    # nested SX string literals: the outer epoch `(eval "…")` and
+    # the inner `(js-eval "…")` that it wraps.
+    #
+    # Source char → final stream char
+    #   \  →  \\\\    (outer: becomes \\ ; inner: becomes \)
+    #   "  →  \\\"    (outer: becomes \" ; inner: becomes ")
+    #   nl →  \\n     (SX newline escape, survives both levels)
+    src=$(python3 -c '
+import sys
+s = open(sys.argv[1], "r", encoding="utf-8").read().rstrip("\n")
+# Two nested SX string literals: outer eval wraps inner js-eval.
+# Escape once for inner (JS source → SX inner string literal):
+inner = s.replace("\\", "\\\\").replace("\"", "\\\"").replace("\n", "\\n")
+# Escape the result again for the outer SX string literal:
+outer = inner.replace("\\", "\\\\").replace("\"", "\\\"")
+sys.stdout.write(outer)
+' "$f")
+    echo "(epoch $epoch)"
+    echo "(eval \"(js-eval \\\"$src\\\")\")"
+    epoch=$((epoch + 1))
+  done
+} > "$TMPFILE"
+
+OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
+
+# Iterate fixtures with the same epoch sequence and check each.
+epoch=100
+for f in "${FIXTURES[@]}"; do
+  expected=$(cat "${f%.js}.expected" | sed -e 's/[[:space:]]*$//' | head -n 1)
+  name="${f#${SLICE_DIR}/}"
+  name="${name%.js}"
+
+  # Actual output lives on the line after "(ok-len $epoch N)" or on
+  # "(ok $epoch VAL)" for short values. Errors surface as "(error …)".
+  actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
+    $0 ~ ("^\\(ok-len "e" ") { getline; print; exit }
+    $0 ~ ("^\\(ok "e" ") { sub("^\\(ok "e" ", ""); sub(")$", ""); print; exit }
+    $0 ~ ("^\\(error "e" ") { print; exit }
+  ')
+  [ -z "$actual" ] && actual="<no output>"
+
+  if echo "$actual" | grep -qF -- "$expected"; then
+    PASS=$((PASS + 1))
+    [ "$VERBOSE" = "-v" ] && echo "  ✓ $name"
+  else
+    FAIL=$((FAIL + 1))
+    ERRORS+="  ✗ $name
+    expected: $expected
+    actual:   $actual
+"
+    [ "$VERBOSE" = "-v" ] && echo "  ✗ $name (expected: $expected, actual: $actual)"
+  fi
+
+  epoch=$((epoch + 1))
+done
+
+TOTAL=$((PASS + FAIL))
+PCT=$(awk "BEGIN{printf \"%.1f\", ($PASS/$TOTAL)*100}")
+
+echo
+if [ $FAIL -eq 0 ]; then
+  echo "✓ $PASS/$TOTAL test262-slice tests passed ($PCT%)"
+else
+  echo "✗ $PASS/$TOTAL passed, $FAIL failed ($PCT%):"
+  [ "$VERBOSE" != "-v" ] && echo "$ERRORS"
+fi
+
+# Phase 5 target: ≥50% pass.
+TARGET=50
+if (( $(echo "$PCT >= $TARGET" | bc -l 2>/dev/null || python3 -c "print($PCT >= $TARGET)") )); then
+  exit 0
+else
+  echo "(below target of ${TARGET}%)"
+  exit 1
+fi

lib/js/lexer.sx

@@ -0,0 +1,609 @@
+;; lib/js/lexer.sx — JavaScript source → token stream
+;;
+;; Tokens: {:type T :value V :pos P}
+;; Types:
+;;   "number"  — numeric literals (decoded into value as number)
+;;   "string"  — string literals (decoded, escape sequences processed)
+;;   "template"— template literal body (no interpolation split yet — deferred)
+;;   "ident"   — identifier (not a reserved word)
+;;   "keyword" — reserved word
+;;   "punct"   — ( ) [ ] { } , ; : . ...
+;;   "op"      — all operator tokens (incl. = == === !== < > etc.)
+;;   "eof"     — end of input
+;;
+;; NOTE: `cond` clauses take exactly ONE body expression — multi-body
+;; clauses must wrap their body in `(do ...)`.
+
+;; ── Token constructor ─────────────────────────────────────────────
+(define js-make-token (fn (type value pos) {:pos pos :value value :type type}))
+
+;; ── Character predicates ──────────────────────────────────────────
+(define js-digit? (fn (c) (and (>= c "0") (<= c "9"))))
+
+(define
+  js-hex-digit?
+  (fn
+    (c)
+    (or
+      (js-digit? c)
+      (and (>= c "a") (<= c "f"))
+      (and (>= c "A") (<= c "F")))))
+
+(define
+  js-letter?
+  (fn (c) (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")))))
+
+(define js-ident-start? (fn (c) (or (js-letter? c) (= c "_") (= c "$"))))
+
+(define js-ident-char? (fn (c) (or (js-ident-start? c) (js-digit? c))))
+
+(define js-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
+
+;; ── Reserved words ────────────────────────────────────────────────
+(define
+  js-keywords
+  (list
+    "break"
+    "case"
+    "catch"
+    "class"
+    "const"
+    "continue"
+    "debugger"
+    "default"
+    "delete"
+    "do"
+    "else"
+    "export"
+    "extends"
+    "false"
+    "finally"
+    "for"
+    "function"
+    "if"
+    "import"
+    "in"
+    "instanceof"
+    "new"
+    "null"
+    "return"
+    "super"
+    "switch"
+    "this"
+    "throw"
+    "true"
+    "try"
+    "typeof"
+    "undefined"
+    "var"
+    "void"
+    "while"
+    "with"
+    "yield"
+    "let"
+    "static"
+    "async"
+    "await"
+    "of"))
+
+(define js-keyword? (fn (word) (contains? js-keywords word)))
+
+;; ── Main tokenizer ────────────────────────────────────────────────
+(define
+  js-tokenize
+  (fn
+    (src)
+    (let
+      ((tokens (list)) (pos 0) (src-len (len src)))
+      (define
+        js-peek
+        (fn
+          (offset)
+          (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
+      (define cur (fn () (js-peek 0)))
+      (define advance! (fn (n) (set! pos (+ pos n))))
+      (define
+        at?
+        (fn
+          (s)
+          (let
+            ((sl (len s)))
+            (and (<= (+ pos sl) src-len) (= (slice src pos (+ pos sl)) s)))))
+      (define
+        js-emit!
+        (fn
+          (type value start)
+          (append! tokens (js-make-token type value start))))
+      (define
+        skip-line-comment!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (not (= (cur) "\n")))
+            (do (advance! 1) (skip-line-comment!)))))
+      (define
+        skip-block-comment!
+        (fn
+          ()
+          (cond
+            ((>= pos src-len) nil)
+            ((and (= (cur) "*") (< (+ pos 1) src-len) (= (js-peek 1) "/"))
+              (advance! 2))
+            (else (do (advance! 1) (skip-block-comment!))))))
+      (define
+        skip-ws!
+        (fn
+          ()
+          (cond
+            ((>= pos src-len) nil)
+            ((js-ws? (cur)) (do (advance! 1) (skip-ws!)))
+            ((and (= (cur) "/") (< (+ pos 1) src-len) (= (js-peek 1) "/"))
+              (do (advance! 2) (skip-line-comment!) (skip-ws!)))
+            ((and (= (cur) "/") (< (+ pos 1) src-len) (= (js-peek 1) "*"))
+              (do (advance! 2) (skip-block-comment!) (skip-ws!)))
+            (else nil))))
+      (define
+        read-ident
+        (fn
+          (start)
+          (do
+            (when
+              (and (< pos src-len) (js-ident-char? (cur)))
+              (do (advance! 1) (read-ident start)))
+            (slice src start pos))))
+      (define
+        read-decimal-digits!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (js-digit? (cur)))
+            (do (advance! 1) (read-decimal-digits!)))))
+      (define
+        read-hex-digits!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (js-hex-digit? (cur)))
+            (do (advance! 1) (read-hex-digits!)))))
+      (define
+        read-exp-part!
+        (fn
+          ()
+          (when
+            (and (< pos src-len) (or (= (cur) "e") (= (cur) "E")))
+            (let
+              ((p1 (js-peek 1)))
+              (when
+                (or
+                  (and (not (= p1 nil)) (js-digit? p1))
+                  (and
+                    (or (= p1 "+") (= p1 "-"))
+                    (< (+ pos 2) src-len)
+                    (js-digit? (js-peek 2))))
+                (do
+                  (advance! 1)
+                  (when
+                    (and
+                      (< pos src-len)
+                      (or (= (cur) "+") (= (cur) "-")))
+                    (advance! 1))
+                  (read-decimal-digits!)))))))
+      (define
+        read-number
+        (fn
+          (start)
+          (cond
+            ((and (= (cur) "0") (< (+ pos 1) src-len) (or (= (js-peek 1) "x") (= (js-peek 1) "X")))
+              (do
+                (advance! 2)
+                (read-hex-digits!)
+                (let
+                  ((raw (slice src (+ start 2) pos)))
+                  (parse-number (str "0x" raw)))))
+            (else
+              (do
+                (read-decimal-digits!)
+                (when
+                  (and
+                    (< pos src-len)
+                    (= (cur) ".")
+                    (< (+ pos 1) src-len)
+                    (js-digit? (js-peek 1)))
+                  (do (advance! 1) (read-decimal-digits!)))
+                (read-exp-part!)
+                (parse-number (slice src start pos)))))))
+      (define
+        read-dot-number
+        (fn
+          (start)
+          (do
+            (advance! 1)
+            (read-decimal-digits!)
+            (read-exp-part!)
+            (parse-number (slice src start pos)))))
+      (define
+        read-string
+        (fn
+          (quote-char)
+          (let
+            ((chars (list)))
+            (advance! 1)
+            (define
+              loop
+              (fn
+                ()
+                (cond
+                  ((>= pos src-len) nil)
+                  ((= (cur) "\\")
+                    (do
+                      (advance! 1)
+                      (when
+                        (< pos src-len)
+                        (let
+                          ((ch (cur)))
+                          (do
+                            (cond
+                              ((= ch "n") (append! chars "\n"))
+                              ((= ch "t") (append! chars "\t"))
+                              ((= ch "r") (append! chars "\r"))
+                              ((= ch "\\") (append! chars "\\"))
+                              ((= ch "'") (append! chars "'"))
+                              ((= ch "\"") (append! chars "\""))
+                              ((= ch "`") (append! chars "`"))
+                              ((= ch "0") (append! chars "\\0"))
+                              ((= ch "b") (append! chars "\\b"))
+                              ((= ch "f") (append! chars "\\f"))
+                              ((= ch "v") (append! chars "\\v"))
+                              (else (append! chars ch)))
+                            (advance! 1))))
+                      (loop)))
+                  ((= (cur) quote-char) (advance! 1))
+                  (else (do (append! chars (cur)) (advance! 1) (loop))))))
+            (loop)
+            (join "" chars))))
+      (define
+        read-template
+        (fn
+          ()
+          (let
+            ((parts (list)) (chars (list)))
+            (advance! 1)
+            (define
+              flush-chars!
+              (fn
+                ()
+                (when
+                  (> (len chars) 0)
+                  (do
+                    (append! parts (list "str" (join "" chars)))
+                    (set! chars (list))))))
+            (define
+              read-expr-source!
+              (fn
+                ()
+                (let
+                  ((buf (list)) (depth 1))
+                  (define
+                    expr-loop
+                    (fn
+                      ()
+                      (cond
+                        ((>= pos src-len) nil)
+                        ((and (= (cur) "}") (= depth 1)) (advance! 1))
+                        ((= (cur) "}")
+                          (do
+                            (append! buf (cur))
+                            (set! depth (- depth 1))
+                            (advance! 1)
+                            (expr-loop)))
+                        ((= (cur) "{")
+                          (do
+                            (append! buf (cur))
+                            (set! depth (+ depth 1))
+                            (advance! 1)
+                            (expr-loop)))
+                        ((or (= (cur) "\"") (= (cur) "'"))
+                          (let
+                            ((q (cur)))
+                            (do
+                              (append! buf q)
+                              (advance! 1)
+                              (define
+                                sloop
+                                (fn
+                                  ()
+                                  (cond
+                                    ((>= pos src-len) nil)
+                                    ((= (cur) "\\")
+                                      (do
+                                        (append! buf (cur))
+                                        (advance! 1)
+                                        (when
+                                          (< pos src-len)
+                                          (do
+                                            (append! buf (cur))
+                                            (advance! 1)))
+                                        (sloop)))
+                                    ((= (cur) q)
+                                      (do (append! buf (cur)) (advance! 1)))
+                                    (else
+                                      (do
+                                        (append! buf (cur))
+                                        (advance! 1)
+                                        (sloop))))))
+                              (sloop)
+                              (expr-loop))))
+                        (else
+                          (do (append! buf (cur)) (advance! 1) (expr-loop))))))
+                  (expr-loop)
+                  (join "" buf))))
+            (define
+              loop
+              (fn
+                ()
+                (cond
+                  ((>= pos src-len) nil)
+                  ((= (cur) "`") (advance! 1))
+                  ((and (= (cur) "$") (< (+ pos 1) src-len) (= (js-peek 1) "{"))
+                    (do
+                      (flush-chars!)
+                      (advance! 2)
+                      (let
+                        ((src (read-expr-source!)))
+                        (append! parts (list "expr" src)))
+                      (loop)))
+                  ((= (cur) "\\")
+                    (do
+                      (advance! 1)
+                      (when
+                        (< pos src-len)
+                        (let
+                          ((ch (cur)))
+                          (do
+                            (cond
+                              ((= ch "n") (append! chars "\n"))
+                              ((= ch "t") (append! chars "\t"))
+                              ((= ch "r") (append! chars "\r"))
+                              ((= ch "\\") (append! chars "\\"))
+                              ((= ch "'") (append! chars "'"))
+                              ((= ch "\"") (append! chars "\""))
+                              ((= ch "`") (append! chars "`"))
+                              ((= ch "$") (append! chars "$"))
+                              ((= ch "0") (append! chars "0"))
+                              ((= ch "b") (append! chars "b"))
+                              ((= ch "f") (append! chars "f"))
+                              ((= ch "v") (append! chars "v"))
+                              (else (append! chars ch)))
+                            (advance! 1))))
+                      (loop)))
+                  (else (do (append! chars (cur)) (advance! 1) (loop))))))
+            (loop)
+            (flush-chars!)
+            (if
+              (= (len parts) 0)
+              ""
+              (if
+                (and (= (len parts) 1) (= (nth (nth parts 0) 0) "str"))
+                (nth (nth parts 0) 1)
+                parts)))))
+      (define
+        js-regex-context?
+        (fn
+          ()
+          (if
+            (= (len tokens) 0)
+            true
+            (let
+              ((tk (nth tokens (- (len tokens) 1))))
+              (let
+                ((ty (dict-get tk "type")) (vv (dict-get tk "value")))
+                (cond
+                  ((= ty "punct")
+                    (and (not (= vv ")")) (not (= vv "]"))))
+                  ((= ty "op") true)
+                  ((= ty "keyword")
+                    (contains?
+                      (list
+                        "return"
+                        "typeof"
+                        "in"
+                        "of"
+                        "throw"
+                        "new"
+                        "delete"
+                        "instanceof"
+                        "void"
+                        "yield"
+                        "await"
+                        "case"
+                        "do"
+                        "else")
+                      vv))
+                  (else false)))))))
+      (define
+        read-regex
+        (fn
+          ()
+          (let
+            ((buf (list)) (in-class false))
+            (advance! 1)
+            (define
+              body-loop
+              (fn
+                ()
+                (cond
+                  ((>= pos src-len) nil)
+                  ((= (cur) "\\")
+                    (begin
+                      (append! buf (cur))
+                      (advance! 1)
+                      (when
+                        (< pos src-len)
+                        (begin (append! buf (cur)) (advance! 1)))
+                      (body-loop)))
+                  ((= (cur) "[")
+                    (begin
+                      (set! in-class true)
+                      (append! buf (cur))
+                      (advance! 1)
+                      (body-loop)))
+                  ((= (cur) "]")
+                    (begin
+                      (set! in-class false)
+                      (append! buf (cur))
+                      (advance! 1)
+                      (body-loop)))
+                  ((and (= (cur) "/") (not in-class)) (advance! 1))
+                  (else
+                    (begin (append! buf (cur)) (advance! 1) (body-loop))))))
+            (body-loop)
+            (let
+              ((flags-buf (list)))
+              (define
+                flags-loop
+                (fn
+                  ()
+                  (when
+                    (and (< pos src-len) (js-ident-char? (cur)))
+                    (begin
+                      (append! flags-buf (cur))
+                      (advance! 1)
+                      (flags-loop)))))
+              (flags-loop)
+              {:pattern (join "" buf) :flags (join "" flags-buf)}))))
+      (define
+        try-op-4!
+        (fn
+          (start)
+          (cond
+            ((at? ">>>=")
+              (do (js-emit! "op" ">>>=" start) (advance! 4) true))
+            (else false))))
+      (define
+        try-op-3!
+        (fn
+          (start)
+          (cond
+            ((at? "===")
+              (do (js-emit! "op" "===" start) (advance! 3) true))
+            ((at? "!==")
+              (do (js-emit! "op" "!==" start) (advance! 3) true))
+            ((at? "**=")
+              (do (js-emit! "op" "**=" start) (advance! 3) true))
+            ((at? "<<=")
+              (do (js-emit! "op" "<<=" start) (advance! 3) true))
+            ((at? ">>=")
+              (do (js-emit! "op" ">>=" start) (advance! 3) true))
+            ((at? ">>>")
+              (do (js-emit! "op" ">>>" start) (advance! 3) true))
+            ((at? "&&=")
+              (do (js-emit! "op" "&&=" start) (advance! 3) true))
+            ((at? "||=")
+              (do (js-emit! "op" "||=" start) (advance! 3) true))
+            ((at? "??=")
+              (do (js-emit! "op" "??=" start) (advance! 3) true))
+            ((at? "...")
+              (do (js-emit! "punct" "..." start) (advance! 3) true))
+            (else false))))
+      (define
+        try-op-2!
+        (fn
+          (start)
+          (cond
+            ((at? "==") (do (js-emit! "op" "==" start) (advance! 2) true))
+            ((at? "!=") (do (js-emit! "op" "!=" start) (advance! 2) true))
+            ((at? "<=") (do (js-emit! "op" "<=" start) (advance! 2) true))
+            ((at? ">=") (do (js-emit! "op" ">=" start) (advance! 2) true))
+            ((at? "&&") (do (js-emit! "op" "&&" start) (advance! 2) true))
+            ((at? "||") (do (js-emit! "op" "||" start) (advance! 2) true))
+            ((at? "??") (do (js-emit! "op" "??" start) (advance! 2) true))
+            ((at? "=>") (do (js-emit! "op" "=>" start) (advance! 2) true))
+            ((at? "**") (do (js-emit! "op" "**" start) (advance! 2) true))
+            ((at? "<<") (do (js-emit! "op" "<<" start) (advance! 2) true))
+            ((at? ">>") (do (js-emit! "op" ">>" start) (advance! 2) true))
+            ((at? "++") (do (js-emit! "op" "++" start) (advance! 2) true))
+            ((at? "--") (do (js-emit! "op" "--" start) (advance! 2) true))
+            ((at? "+=") (do (js-emit! "op" "+=" start) (advance! 2) true))
+            ((at? "-=") (do (js-emit! "op" "-=" start) (advance! 2) true))
+            ((at? "*=") (do (js-emit! "op" "*=" start) (advance! 2) true))
+            ((at? "/=") (do (js-emit! "op" "/=" start) (advance! 2) true))
+            ((at? "%=") (do (js-emit! "op" "%=" start) (advance! 2) true))
+            ((at? "&=") (do (js-emit! "op" "&=" start) (advance! 2) true))
+            ((at? "|=") (do (js-emit! "op" "|=" start) (advance! 2) true))
+            ((at? "^=") (do (js-emit! "op" "^=" start) (advance! 2) true))
+            ((at? "?.") (do (js-emit! "op" "?." start) (advance! 2) true))
+            (else false))))
+      (define
+        emit-one-op!
+        (fn
+          (ch start)
+          (cond
+            ((= ch "(") (do (js-emit! "punct" "(" start) (advance! 1)))
+            ((= ch ")") (do (js-emit! "punct" ")" start) (advance! 1)))
+            ((= ch "[") (do (js-emit! "punct" "[" start) (advance! 1)))
+            ((= ch "]") (do (js-emit! "punct" "]" start) (advance! 1)))
+            ((= ch "{") (do (js-emit! "punct" "{" start) (advance! 1)))
+            ((= ch "}") (do (js-emit! "punct" "}" start) (advance! 1)))
+            ((= ch ",") (do (js-emit! "punct" "," start) (advance! 1)))
+            ((= ch ";") (do (js-emit! "punct" ";" start) (advance! 1)))
+            ((= ch ":") (do (js-emit! "punct" ":" start) (advance! 1)))
+            ((= ch ".") (do (js-emit! "punct" "." start) (advance! 1)))
+            ((= ch "?") (do (js-emit! "op" "?" start) (advance! 1)))
+            ((= ch "+") (do (js-emit! "op" "+" start) (advance! 1)))
+            ((= ch "-") (do (js-emit! "op" "-" start) (advance! 1)))
+            ((= ch "*") (do (js-emit! "op" "*" start) (advance! 1)))
+            ((= ch "/") (do (js-emit! "op" "/" start) (advance! 1)))
+            ((= ch "%") (do (js-emit! "op" "%" start) (advance! 1)))
+            ((= ch "=") (do (js-emit! "op" "=" start) (advance! 1)))
+            ((= ch "<") (do (js-emit! "op" "<" start) (advance! 1)))
+            ((= ch ">") (do (js-emit! "op" ">" start) (advance! 1)))
+            ((= ch "!") (do (js-emit! "op" "!" start) (advance! 1)))
+            ((= ch "&") (do (js-emit! "op" "&" start) (advance! 1)))
+            ((= ch "|") (do (js-emit! "op" "|" start) (advance! 1)))
+            ((= ch "^") (do (js-emit! "op" "^" start) (advance! 1)))
+            ((= ch "~") (do (js-emit! "op" "~" start) (advance! 1)))
+            (else (advance! 1)))))
+      (define
+        scan!
+        (fn
+          ()
+          (do
+            (skip-ws!)
+            (when
+              (< pos src-len)
+              (let
+                ((ch (cur)) (start pos))
+                (cond
+                  ((or (= ch "\"") (= ch "'"))
+                    (do (js-emit! "string" (read-string ch) start) (scan!)))
+                  ((= ch "`")
+                    (do (js-emit! "template" (read-template) start) (scan!)))
+                  ((js-digit? ch)
+                    (do
+                      (js-emit! "number" (read-number start) start)
+                      (scan!)))
+                  ((and (= ch ".") (< (+ pos 1) src-len) (js-digit? (js-peek 1)))
+                    (do
+                      (js-emit! "number" (read-dot-number start) start)
+                      (scan!)))
+                  ((js-ident-start? ch)
+                    (do
+                      (let
+                        ((word (read-ident start)))
+                        (js-emit!
+                          (if (js-keyword? word) "keyword" "ident")
+                          word
+                          start))
+                      (scan!)))
+                  ((and (= ch "/") (js-regex-context?))
+                    (let
+                      ((rx (read-regex)))
+                      (js-emit! "regex" rx start)
+                      (scan!)))
+                  ((try-op-4! start) (scan!))
+                  ((try-op-3! start) (scan!))
+                  ((try-op-2! start) (scan!))
+                  (else (do (emit-one-op! ch start) (scan!)))))))))
+      (scan!)
+      (js-emit! "eof" nil pos)
+      tokens)))

lib/js/test262-scoreboard-wide.json

@@ -0,0 +1,313 @@
+{
+  "totals": {
+    "pass": 259,
+    "fail": 4768,
+    "skip": 2534,
+    "timeout": 327,
+    "total": 7888,
+    "runnable": 5354,
+    "pass_rate": 4.8
+  },
+  "categories": [
+    {
+      "category": "built-ins/Array",
+      "total": 3081,
+      "pass": 58,
+      "fail": 2524,
+      "skip": 351,
+      "timeout": 148,
+      "pass_rate": 2.1,
+      "top_failures": [
+        [
+          "ReferenceError (undefined symbol)",
+          785
+        ],
+        [
+          "Other: \"Not callable: {:length 3 :0 41 :1 42 :2 43} (kont=5 frames)\"",
+          455
+        ],
+        [
+          "Unhandled: Unhandled exception: \\\\\\",
+          420
+        ],
+        [
+          "TypeError: not a function",
+          284
+        ],
+        [
+          "Timeout",
+          148
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/ArrayBuffer",
+      "total": 196,
+      "pass": 0,
+      "fail": 0,
+      "skip": 196,
+      "timeout": 0,
+      "pass_rate": 0.0,
+      "top_failures": []
+    },
+    {
+      "category": "built-ins/ArrayIteratorPrototype",
+      "total": 27,
+      "pass": 0,
+      "fail": 0,
+      "skip": 27,
+      "timeout": 0,
+      "pass_rate": 0.0,
+      "top_failures": []
+    },
+    {
+      "category": "built-ins/Math",
+      "total": 327,
+      "pass": 65,
+      "fail": 211,
+      "skip": 39,
+      "timeout": 12,
+      "pass_rate": 22.6,
+      "top_failures": [
+        [
+          "ReferenceError (undefined symbol)",
+          87
+        ],
+        [
+          "Test262Error (assertion failed)",
+          80
+        ],
+        [
+          "TypeError: not a function",
+          31
+        ],
+        [
+          "Timeout",
+          12
+        ],
+        [
+          "Unhandled: Not callable: {:isArray <js-array-is-array(v)> :of <js-array",
+          11
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/Number",
+      "total": 340,
+      "pass": 9,
+      "fail": 252,
+      "skip": 57,
+      "timeout": 22,
+      "pass_rate": 3.2,
+      "top_failures": [
+        [
+          "TypeError: not a function",
+          72
+        ],
+        [
+          "Unhandled: Not callable: {:isFinite <js-number-is-finite(v)> :MAX_SAFE_",
+          56
+        ],
+        [
+          "ReferenceError (undefined symbol)",
+          49
+        ],
+        [
+          "Unhandled: expected ident after .\\",
+          38
+        ],
+        [
+          "Timeout",
+          22
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/String",
+      "total": 1223,
+      "pass": 73,
+      "fail": 847,
+      "skip": 192,
+      "timeout": 111,
+      "pass_rate": 7.1,
+      "top_failures": [
+        [
+          "Unhandled: Not callable: \\\\\\",
+          152
+        ],
+        [
+          "Unhandled: Not callable: {:fromCharCode <js-string-from-char-code(&rest",
+          133
+        ],
+        [
+          "Test262Error (assertion failed)",
+          124
+        ],
+        [
+          "TypeError: not a function",
+          117
+        ],
+        [
+          "Other: \"Not callable: \\\"js-undefined\\\" (kont=10 frames)\"",
+          117
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/StringIteratorPrototype",
+      "total": 7,
+      "pass": 0,
+      "fail": 0,
+      "skip": 7,
+      "timeout": 0,
+      "pass_rate": 0.0,
+      "top_failures": []
+    },
+    {
+      "category": "language/expressions",
+      "total": 95,
+      "pass": 14,
+      "fail": 36,
+      "skip": 29,
+      "timeout": 16,
+      "pass_rate": 21.2,
+      "top_failures": [
+        [
+          "Timeout",
+          16
+        ],
+        [
+          "ReferenceError (undefined symbol)",
+          14
+        ],
+        [
+          "Test262Error (assertion failed)",
+          12
+        ],
+        [
+          "Unhandled: Not callable: {:fromCharCode <js-string-from-char-code(&rest",
+          3
+        ],
+        [
+          "Unhandled: Not callable: {:entries <js-object-entries(o)> :values <js-o",
+          2
+        ]
+      ]
+    },
+    {
+      "category": "language/statements",
+      "total": 2592,
+      "pass": 40,
+      "fail": 898,
+      "skip": 1636,
+      "timeout": 18,
+      "pass_rate": 4.2,
+      "top_failures": [
+        [
+          "SyntaxError (parse/unsupported syntax)",
+          387
+        ],
+        [
+          "Unhandled: expected ident in arr pattern\\",
+          112
+        ],
+        [
+          "Other: \"Not callable: \\\"ud801\\\" (kont=6 frames)\"",
+          49
+        ],
+        [
+          "negative: expected SyntaxError, got: \"Unhandled exception: \\\"expected ident in arr pattern\\\"\"",
+          36
+        ],
+        [
+          "ReferenceError (undefined symbol)",
+          33
+        ]
+      ]
+    }
+  ],
+  "top_failure_modes": [
+    [
+      "ReferenceError (undefined symbol)",
+      1056
+    ],
+    [
+      "TypeError: not a function",
+      514
+    ],
+    [
+      "Other: \"Not callable: {:length 3 :0 41 :1 42 :2 43} (kont=5 frames)\"",
+      455
+    ],
+    [
+      "SyntaxError (parse/unsupported syntax)",
+      454
+    ],
+    [
+      "Unhandled: Unhandled exception: \\\\\\",
+      438
+    ],
+    [
+      "Timeout",
+      327
+    ],
+    [
+      "Test262Error (assertion failed)",
+      322
+    ],
+    [
+      "Unhandled: Not callable: \\\\\\",
+      160
+    ],
+    [
+      "Unhandled: Not callable: {:fromCharCode <js-string-from-char-code(&rest",
+      147
+    ],
+    [
+      "Unhandled: Unexpected token: punct ','\\",
+      125
+    ],
+    [
+      "Other: \"Not callable: \\\"js-undefined\\\" (kont=10 frames)\"",
+      117
+    ],
+    [
+      "Unhandled: expected ident in arr pattern\\",
+      112
+    ],
+    [
+      "Unhandled: js-transpile-unop: unsupported op: delete\\",
+      104
+    ],
+    [
+      "Unhandled: Not callable: {:isFinite <js-number-is-finite(v)> :MAX_SAFE_",
+      74
+    ],
+    [
+      "Unhandled: Not callable: {:sameValue <lambda(actual, expected, message)",
+      63
+    ],
+    [
+      "Other: \"Not callable: \\\"ud801\\\" (kont=6 frames)\"",
+      49
+    ],
+    [
+      "Unhandled: Not callable: {:isArray <js-array-is-array(v)> :of <js-array",
+      46
+    ],
+    [
+      "Unhandled: expected ident after .\\",
+      45
+    ],
+    [
+      "Unhandled: Unexpected token: op '++'\\",
+      39
+    ],
+    [
+      "negative: expected SyntaxError, got: \"Unhandled exception: \\\"expected ident in arr pattern\\\"\"",
+      36
+    ]
+  ],
+  "pinned_commit": "d5e73fc8d2c663554fb72e2380a8c2bc1a318a33",
+  "elapsed_seconds": 9007.6
+}

lib/js/test262-scoreboard-wide.md

@@ -0,0 +1,90 @@
+# test262 scoreboard
+
+Pinned commit: `d5e73fc8d2c663554fb72e2380a8c2bc1a318a33`
+Wall time: 9007.6s
+
+**Total:** 259/5354 runnable passed (4.8%). Raw: pass=259 fail=4768 skip=2534 timeout=327 total=7888.
+
+## Top failure modes
+
+- **1056x** ReferenceError (undefined symbol)
+- **514x** TypeError: not a function
+- **455x** Other: "Not callable: {:length 3 :0 41 :1 42 :2 43} (kont=5 frames)"
+- **454x** SyntaxError (parse/unsupported syntax)
+- **438x** Unhandled: Unhandled exception: \\\
+- **327x** Timeout
+- **322x** Test262Error (assertion failed)
+- **160x** Unhandled: Not callable: \\\
+- **147x** Unhandled: Not callable: {:fromCharCode <js-string-from-char-code(&rest
+- **125x** Unhandled: Unexpected token: punct ','\
+- **117x** Other: "Not callable: \"js-undefined\" (kont=10 frames)"
+- **112x** Unhandled: expected ident in arr pattern\
+- **104x** Unhandled: js-transpile-unop: unsupported op: delete\
+- **74x** Unhandled: Not callable: {:isFinite <js-number-is-finite(v)> :MAX_SAFE_
+- **63x** Unhandled: Not callable: {:sameValue <lambda(actual, expected, message)
+- **49x** Other: "Not callable: \"ud801\" (kont=6 frames)"
+- **46x** Unhandled: Not callable: {:isArray <js-array-is-array(v)> :of <js-array
+- **45x** Unhandled: expected ident after .\
+- **39x** Unhandled: Unexpected token: op '++'\
+- **36x** negative: expected SyntaxError, got: "Unhandled exception: \"expected ident in arr pattern\""
+
+## Categories (worst pass-rate first, min 10 runnable)
+
+| Category | Pass | Fail | Skip | Timeout | Total | Pass % |
+|---|---:|---:|---:|---:|---:|---:|
+| built-ins/Array | 58 | 2524 | 351 | 148 | 3081 | 2.1% |
+| built-ins/Number | 9 | 252 | 57 | 22 | 340 | 3.2% |
+| language/statements | 40 | 898 | 1636 | 18 | 2592 | 4.2% |
+| built-ins/String | 73 | 847 | 192 | 111 | 1223 | 7.1% |
+| language/expressions | 14 | 36 | 29 | 16 | 95 | 21.2% |
+| built-ins/Math | 65 | 211 | 39 | 12 | 327 | 22.6% |
+
+## Per-category top failures (min 10 runnable, worst first)
+
+### built-ins/Array  (58/2730 — 2.1%)
+
+- **785x** ReferenceError (undefined symbol)
+- **455x** Other: "Not callable: {:length 3 :0 41 :1 42 :2 43} (kont=5 frames)"
+- **420x** Unhandled: Unhandled exception: \\\
+- **284x** TypeError: not a function
+- **148x** Timeout
+
+### built-ins/Number  (9/283 — 3.2%)
+
+- **72x** TypeError: not a function
+- **56x** Unhandled: Not callable: {:isFinite <js-number-is-finite(v)> :MAX_SAFE_
+- **49x** ReferenceError (undefined symbol)
+- **38x** Unhandled: expected ident after .\
+- **22x** Timeout
+
+### language/statements  (40/956 — 4.2%)
+
+- **387x** SyntaxError (parse/unsupported syntax)
+- **112x** Unhandled: expected ident in arr pattern\
+- **49x** Other: "Not callable: \"ud801\" (kont=6 frames)"
+- **36x** negative: expected SyntaxError, got: "Unhandled exception: \"expected ident in arr pattern\""
+- **33x** ReferenceError (undefined symbol)
+
+### built-ins/String  (73/1031 — 7.1%)
+
+- **152x** Unhandled: Not callable: \\\
+- **133x** Unhandled: Not callable: {:fromCharCode <js-string-from-char-code(&rest
+- **124x** Test262Error (assertion failed)
+- **117x** TypeError: not a function
+- **117x** Other: "Not callable: \"js-undefined\" (kont=10 frames)"
+
+### language/expressions  (14/66 — 21.2%)
+
+- **16x** Timeout
+- **14x** ReferenceError (undefined symbol)
+- **12x** Test262Error (assertion failed)
+- **3x** Unhandled: Not callable: {:fromCharCode <js-string-from-char-code(&rest
+- **2x** Unhandled: Not callable: {:entries <js-object-entries(o)> :values <js-o
+
+### built-ins/Math  (65/288 — 22.6%)
+
+- **87x** ReferenceError (undefined symbol)
+- **80x** Test262Error (assertion failed)
+- **31x** TypeError: not a function
+- **12x** Timeout
+- **11x** Unhandled: Not callable: {:isArray <js-array-is-array(v)> :of <js-array

lib/js/test262-scoreboard.json

@@ -0,0 +1,137 @@
+{
+  "totals": {
+    "pass": 162,
+    "fail": 128,
+    "skip": 1597,
+    "timeout": 10,
+    "total": 1897,
+    "runnable": 300,
+    "pass_rate": 54.0
+  },
+  "categories": [
+    {
+      "category": "built-ins/Math",
+      "total": 327,
+      "pass": 43,
+      "fail": 56,
+      "skip": 227,
+      "timeout": 1,
+      "pass_rate": 43.0,
+      "top_failures": [
+        [
+          "TypeError: not a function",
+          36
+        ],
+        [
+          "Test262Error (assertion failed)",
+          20
+        ],
+        [
+          "Timeout",
+          1
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/Number",
+      "total": 340,
+      "pass": 77,
+      "fail": 19,
+      "skip": 240,
+      "timeout": 4,
+      "pass_rate": 77.0,
+      "top_failures": [
+        [
+          "Test262Error (assertion failed)",
+          19
+        ],
+        [
+          "Timeout",
+          4
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/String",
+      "total": 1223,
+      "pass": 42,
+      "fail": 53,
+      "skip": 1123,
+      "timeout": 5,
+      "pass_rate": 42.0,
+      "top_failures": [
+        [
+          "Test262Error (assertion failed)",
+          44
+        ],
+        [
+          "Timeout",
+          5
+        ],
+        [
+          "ReferenceError (undefined symbol)",
+          2
+        ],
+        [
+          "Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)",
+          2
+        ],
+        [
+          "Unhandled: Not callable: \\\\\\",
+          2
+        ]
+      ]
+    },
+    {
+      "category": "built-ins/StringIteratorPrototype",
+      "total": 7,
+      "pass": 0,
+      "fail": 0,
+      "skip": 7,
+      "timeout": 0,
+      "pass_rate": 0.0,
+      "top_failures": []
+    }
+  ],
+  "top_failure_modes": [
+    [
+      "Test262Error (assertion failed)",
+      83
+    ],
+    [
+      "TypeError: not a function",
+      36
+    ],
+    [
+      "Timeout",
+      10
+    ],
+    [
+      "ReferenceError (undefined symbol)",
+      2
+    ],
+    [
+      "Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)",
+      2
+    ],
+    [
+      "Unhandled: Not callable: \\\\\\",
+      2
+    ],
+    [
+      "SyntaxError (parse/unsupported syntax)",
+      1
+    ],
+    [
+      "Unhandled: Not callable: {:__proto__ {:valueOf <lambda()> :propertyIsEn",
+      1
+    ],
+    [
+      "Unhandled: js-transpile-binop: unsupported op: >>>\\",
+      1
+    ]
+  ],
+  "pinned_commit": "d5e73fc8d2c663554fb72e2380a8c2bc1a318a33",
+  "elapsed_seconds": 274.5,
+  "workers": 1
+}

lib/js/test262-scoreboard.md

@@ -0,0 +1,47 @@
+# test262 scoreboard
+
+Pinned commit: `d5e73fc8d2c663554fb72e2380a8c2bc1a318a33`
+Wall time: 274.5s
+
+**Total:** 162/300 runnable passed (54.0%). Raw: pass=162 fail=128 skip=1597 timeout=10 total=1897.
+
+## Top failure modes
+
+- **83x** Test262Error (assertion failed)
+- **36x** TypeError: not a function
+- **10x** Timeout
+- **2x** ReferenceError (undefined symbol)
+- **2x** Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)
+- **2x** Unhandled: Not callable: \\\
+- **1x** SyntaxError (parse/unsupported syntax)
+- **1x** Unhandled: Not callable: {:__proto__ {:valueOf <lambda()> :propertyIsEn
+- **1x** Unhandled: js-transpile-binop: unsupported op: >>>\
+
+## Categories (worst pass-rate first, min 10 runnable)
+
+| Category | Pass | Fail | Skip | Timeout | Total | Pass % |
+|---|---:|---:|---:|---:|---:|---:|
+| built-ins/String | 42 | 53 | 1123 | 5 | 1223 | 42.0% |
+| built-ins/Math | 43 | 56 | 227 | 1 | 327 | 43.0% |
+| built-ins/Number | 77 | 19 | 240 | 4 | 340 | 77.0% |
+
+## Per-category top failures (min 10 runnable, worst first)
+
+### built-ins/String  (42/100 — 42.0%)
+
+- **44x** Test262Error (assertion failed)
+- **5x** Timeout
+- **2x** ReferenceError (undefined symbol)
+- **2x** Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)
+- **2x** Unhandled: Not callable: \\\
+
+### built-ins/Math  (43/100 — 43.0%)
+
+- **36x** TypeError: not a function
+- **20x** Test262Error (assertion failed)
+- **1x** Timeout
+
+### built-ins/Number  (77/100 — 77.0%)
+
+- **19x** Test262Error (assertion failed)
+- **4x** Timeout

lib/js/test262-slice/README.md

@@ -0,0 +1,31 @@
+# JS-on-SX cherry-picked conformance slice
+
+A hand-picked slice inspired by test262 expression tests. Each test is one
+JS expression in a `.js` file, paired with an `.expected` file containing
+the SX-printed result that `js-eval` should produce.
+
+Run via:
+
+    bash lib/js/conformance.sh
+
+The slice intentionally avoids anything not yet implemented (statements,
+`var`/`let`, `function`, regex, template strings, prototypes, `new`,
+`this`, classes, async). Those land in later phases.
+
+## Expected value format
+
+`js-eval` returns SX values. The epoch protocol prints them thus:
+
+| JS value         | Expected file contents |
+|------------------|-----------------------|
+| `42`             | `42`                  |
+| `3.14`           | `3.14`                |
+| `true` / `false` | `true` / `false`      |
+| `"hi"`           | `"hi"`                |
+| `null`           | `nil`                 |
+| `undefined`      | `"js-undefined"`      |
+| `[1,2,3]`        | `(1 2 3)`             |
+| `{}`             | `{}`                  |
+
+The runner does a substring match — the `.expected` file can contain just
+the distinguishing part of the result.

lib/js/test262-slice/arithmetic/add.expected

@@ -0,0 +1 @@
+3

lib/js/test262-slice/arithmetic/add.js

@@ -0,0 +1 @@
+1 + 2

lib/js/test262-slice/arithmetic/big_expr.expected

@@ -0,0 +1 @@
+5

lib/js/test262-slice/arithmetic/big_expr.js

@@ -0,0 +1 @@
+1 + 2 * 3 - 4 / 2

lib/js/test262-slice/arithmetic/bitnot.expected

@@ -0,0 +1 @@
+-6

lib/js/test262-slice/arithmetic/bitnot.js

@@ -0,0 +1 @@
+~5

lib/js/test262-slice/arithmetic/chained.expected

@@ -0,0 +1 @@
+10