coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HS: js-block return values + worker stub test

Browse Source 
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 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-26 15:26:26 +00:00
parent 4b69650336
commit 8e8c2a73d6
9 changed files with 188 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
lib/hyperscript/compiler.sx
View File

@@ -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 ─────────────────────────────────

32
lib/hyperscript/parser.sx
View File

@@ -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

18
lib/hyperscript/runtime.sx
View File

@@ -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)))))

19
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -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 ─────────────────────────────────

32
shared/static/wasm/sx/hs-parser.sx
View File

@@ -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

18
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -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)))))

9
spec/tests/test-hyperscript-behavioral.sx
View File

@@ -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")))
)
)

35
tests/hs-run-filtered.js
View File

@@ -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 = {

9
tests/playwright/generate-sx-tests.py
View File

@@ -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")))',
],
}