From 8e8c2a73d6557bbe21a5992870579f3dcd2addbd Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 26 Apr 2026 15:26:26 +0000 Subject: [PATCH] HS: js-block return values + worker stub test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Parser: parse-js-block extracts raw JS source by character positions. Compiler: js-block AST → hs-js-exec call, stores result in it. Runtime: hs-js-exec creates JS Function, handles promise rejection. Test runner: host-new-function/host-promise-state natives + promise monkey-patch. Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/compiler.sx | 19 ++++++++++++ lib/hyperscript/parser.sx | 32 ++++++++++++++++++++- lib/hyperscript/runtime.sx | 18 ++++++++++++ shared/static/wasm/sx/hs-compiler.sx | 19 ++++++++++++ shared/static/wasm/sx/hs-parser.sx | 32 ++++++++++++++++++++- shared/static/wasm/sx/hs-runtime.sx | 18 ++++++++++++ spec/tests/test-hyperscript-behavioral.sx | 9 +++++- tests/hs-run-filtered.js | 35 +++++++++++++++++++++++ tests/playwright/generate-sx-tests.py | 9 ++++++ 9 files changed, 188 insertions(+), 3 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 119c40af..e5329532 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -2268,6 +2268,25 @@ (list (quote hs-halt!) (quote event) (nth ast 1))) ((= head (quote focus!)) (list (quote dom-focus) (hs-to-sx (nth ast 1)))) + ((= head (quote js-block)) + (let + ((params (nth ast 1)) (js-src (nth ast 2))) + (let + ((bound-syms (map (fn (p) (make-symbol p)) params))) + (list + (quote let) + (list + (list + (quote __hs-js) + (list + (quote hs-js-exec) + (cons (quote list) params) + js-src + (cons (quote list) bound-syms)))) + (list + (quote begin) + (list (quote set!) (quote it) (quote __hs-js)) + (quote __hs-js)))))) (true ast))))))))) ;; ── Convenience: source → SX ───────────────────────────────── diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index d5feb58c..cdc172e5 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -2506,6 +2506,33 @@ (let ((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) (list (quote close-element) target)))) + (define + parse-js-block + (fn + () + (let + ((params (if (= (tp-type) "paren-open") (do (adv!) (define collect-params! (fn (acc) (cond ((or (at-end?) (= (tp-type) "paren-close")) (do (when (= (tp-type) "paren-close") (adv!)) acc)) ((= (tp-type) "comma") (do (adv!) (collect-params! acc))) (true (let ((pname (tp-val))) (do (adv!) (collect-params! (append acc pname)))))))) (collect-params! (list))) (list)))) + (let + ((js-start (cur-start))) + (define + skip-to-end! + (fn + () + (if + (or + (at-end?) + (and (= (tp-type) "keyword") (= (tp-val) "end"))) + nil + (do (adv!) (skip-to-end!))))) + (skip-to-end!) + (let + ((js-end (cur-start))) + (let + ((js-src (substring src js-start js-end))) + (when + (and (= (tp-type) "keyword") (= (tp-val) "end")) + (adv!)) + (list (quote js-block) params js-src))))))) (define parse-cmd (fn @@ -2655,6 +2682,8 @@ (do (adv!) (list (quote continue)))) ((and (= typ "keyword") (or (= val "exit") (= val "halt"))) (do (adv!) (list (quote exit)))) + ((and (= typ "keyword") (= val "js")) + (do (adv!) (parse-js-block))) (true (parse-expr)))))) (define parse-cmd-list @@ -2710,7 +2739,8 @@ (= v "close") (= v "pick") (= v "ask") - (= v "answer")))) + (= v "answer") + (= v "js")))) (define cl-collect (fn diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index d9e1590e..f928e69d 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -2588,3 +2588,21 @@ node (walk (hs-node-get node (first keys)) (rest keys))))) (hs-line-for (walk (hs-parse-ast src-str) path)))) + +(define + hs-js-exec + (fn + (param-names js-src bound-args) + (let + ((js-fn (host-new-function param-names js-src))) + (let + ((result (host-call-fn js-fn bound-args))) + (if + (= (host-typeof result) "promise") + (let + ((state (host-promise-state result))) + (if + (and state (= (host-get state "ok") false)) + (raise (host-get state "value")) + (if state (host-get state "value") result))) + result))))) diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index 119c40af..e5329532 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -2268,6 +2268,25 @@ (list (quote hs-halt!) (quote event) (nth ast 1))) ((= head (quote focus!)) (list (quote dom-focus) (hs-to-sx (nth ast 1)))) + ((= head (quote js-block)) + (let + ((params (nth ast 1)) (js-src (nth ast 2))) + (let + ((bound-syms (map (fn (p) (make-symbol p)) params))) + (list + (quote let) + (list + (list + (quote __hs-js) + (list + (quote hs-js-exec) + (cons (quote list) params) + js-src + (cons (quote list) bound-syms)))) + (list + (quote begin) + (list (quote set!) (quote it) (quote __hs-js)) + (quote __hs-js)))))) (true ast))))))))) ;; ── Convenience: source → SX ───────────────────────────────── diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index d5feb58c..cdc172e5 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -2506,6 +2506,33 @@ (let ((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) (list (quote close-element) target)))) + (define + parse-js-block + (fn + () + (let + ((params (if (= (tp-type) "paren-open") (do (adv!) (define collect-params! (fn (acc) (cond ((or (at-end?) (= (tp-type) "paren-close")) (do (when (= (tp-type) "paren-close") (adv!)) acc)) ((= (tp-type) "comma") (do (adv!) (collect-params! acc))) (true (let ((pname (tp-val))) (do (adv!) (collect-params! (append acc pname)))))))) (collect-params! (list))) (list)))) + (let + ((js-start (cur-start))) + (define + skip-to-end! + (fn + () + (if + (or + (at-end?) + (and (= (tp-type) "keyword") (= (tp-val) "end"))) + nil + (do (adv!) (skip-to-end!))))) + (skip-to-end!) + (let + ((js-end (cur-start))) + (let + ((js-src (substring src js-start js-end))) + (when + (and (= (tp-type) "keyword") (= (tp-val) "end")) + (adv!)) + (list (quote js-block) params js-src))))))) (define parse-cmd (fn @@ -2655,6 +2682,8 @@ (do (adv!) (list (quote continue)))) ((and (= typ "keyword") (or (= val "exit") (= val "halt"))) (do (adv!) (list (quote exit)))) + ((and (= typ "keyword") (= val "js")) + (do (adv!) (parse-js-block))) (true (parse-expr)))))) (define parse-cmd-list @@ -2710,7 +2739,8 @@ (= v "close") (= v "pick") (= v "ask") - (= v "answer")))) + (= v "answer") + (= v "js")))) (define cl-collect (fn diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index d9e1590e..f928e69d 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -2588,3 +2588,21 @@ node (walk (hs-node-get node (first keys)) (rest keys))))) (hs-line-for (walk (hs-parse-ast src-str) path)))) + +(define + hs-js-exec + (fn + (param-names js-src bound-args) + (let + ((js-fn (host-new-function param-names js-src))) + (let + ((result (host-call-fn js-fn bound-args))) + (if + (= (host-typeof result) "promise") + (let + ((state (host-promise-state result))) + (if + (and state (= (host-get state "ok") false)) + (raise (host-get state "value")) + (if state (host-get state "value") result))) + result))))) diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index c138237f..fb539388 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -13636,5 +13636,12 @@ end") ;; ── worker (1 tests) ── (defsuite "hs-upstream-worker" (deftest "raises a helpful error when the worker plugin is not installed" - (error "SKIP (untranslated): raises a helpful error when the worker plugin is not installed")) + (hs-cleanup!) + (let ((caught nil)) + (guard (_e (true (set! caught (str _e)))) + (hs-compile "worker MyWorker def noop() end end")) + (assert (not (nil? caught))) + (assert (string-contains? caught "worker plugin")) + (assert (string-contains? caught "hyperscript.org/features/worker"))) + ) ) diff --git a/tests/hs-run-filtered.js b/tests/hs-run-filtered.js index 9e8d6662..84268cfd 100755 --- a/tests/hs-run-filtered.js +++ b/tests/hs-run-filtered.js @@ -568,6 +568,41 @@ K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[]; K.registerNative('host-await',a=>{}); K.registerNative('load-library!',()=>false); +// ── JS block execution support ───────────────────────────────── +// Track promise states for synchronous introspection in hs-js-exec +const _promiseStates = new WeakMap(); +const _origPReject = Promise.reject.bind(Promise); +const _origPResolve = Promise.resolve.bind(Promise); +Promise.reject = function(v) { + const p = _origPReject(v); + _promiseStates.set(p, {ok: false, value: v}); + p.catch(() => {}); // suppress unhandled rejection warning + return p; +}; +Promise.resolve = function(v) { + if (v && typeof v === 'object' && typeof v.then === 'function') return _origPResolve(v); + const p = _origPResolve(v); + _promiseStates.set(p, {ok: true, value: v}); + return p; +}; + +K.registerNative('host-new-function', a => { + const paramList = a[0]; + const src = a[1]; + const params = paramList && paramList._type === 'list' && paramList.items + ? Array.from(paramList.items) + : Array.isArray(paramList) ? paramList : []; + try { return new Function(...params, src); } catch(e) { return null; } +}); + +K.registerNative('host-promise-state', a => { + const p = a[0]; + if (!p || typeof p.then !== 'function') return null; + const s = _promiseStates.get(p); + if (!s) return null; + return {ok: s.ok, value: s.value}; +}); + let _testDeadline = 0; // Mock fetch routes const _fetchRoutes = { diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index a133bf81..cb575f94 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -155,6 +155,15 @@ MANUAL_TEST_BODIES = { ' (assert-contains "foo" _names)', ' (assert-contains "bar" _values))', ], + "raises a helpful error when the worker plugin is not installed": [ + ' (hs-cleanup!)', + ' (let ((caught nil))', + ' (guard (_e (true (set! caught (str _e))))', + ' (hs-compile "worker MyWorker def noop() end end"))', + ' (assert (not (nil? caught)))', + ' (assert (string-contains? caught "worker plugin"))', + ' (assert (string-contains? caught "hyperscript.org/features/worker")))', + ], }