HS: js-block return values + worker stub test
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:
@@ -2268,6 +2268,25 @@
|
|||||||
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
||||||
((= head (quote focus!))
|
((= head (quote focus!))
|
||||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
(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)))))))))
|
(true ast)))))))))
|
||||||
|
|
||||||
;; ── Convenience: source → SX ─────────────────────────────────
|
;; ── Convenience: source → SX ─────────────────────────────────
|
||||||
|
|||||||
@@ -2506,6 +2506,33 @@
|
|||||||
(let
|
(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)))))
|
((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))))
|
(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
|
(define
|
||||||
parse-cmd
|
parse-cmd
|
||||||
(fn
|
(fn
|
||||||
@@ -2655,6 +2682,8 @@
|
|||||||
(do (adv!) (list (quote continue))))
|
(do (adv!) (list (quote continue))))
|
||||||
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
||||||
(do (adv!) (list (quote exit))))
|
(do (adv!) (list (quote exit))))
|
||||||
|
((and (= typ "keyword") (= val "js"))
|
||||||
|
(do (adv!) (parse-js-block)))
|
||||||
(true (parse-expr))))))
|
(true (parse-expr))))))
|
||||||
(define
|
(define
|
||||||
parse-cmd-list
|
parse-cmd-list
|
||||||
@@ -2710,7 +2739,8 @@
|
|||||||
(= v "close")
|
(= v "close")
|
||||||
(= v "pick")
|
(= v "pick")
|
||||||
(= v "ask")
|
(= v "ask")
|
||||||
(= v "answer"))))
|
(= v "answer")
|
||||||
|
(= v "js"))))
|
||||||
(define
|
(define
|
||||||
cl-collect
|
cl-collect
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -2588,3 +2588,21 @@
|
|||||||
node
|
node
|
||||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||||
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
(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)))))
|
||||||
|
|||||||
@@ -2268,6 +2268,25 @@
|
|||||||
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
||||||
((= head (quote focus!))
|
((= head (quote focus!))
|
||||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
(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)))))))))
|
(true ast)))))))))
|
||||||
|
|
||||||
;; ── Convenience: source → SX ─────────────────────────────────
|
;; ── Convenience: source → SX ─────────────────────────────────
|
||||||
|
|||||||
@@ -2506,6 +2506,33 @@
|
|||||||
(let
|
(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)))))
|
((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))))
|
(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
|
(define
|
||||||
parse-cmd
|
parse-cmd
|
||||||
(fn
|
(fn
|
||||||
@@ -2655,6 +2682,8 @@
|
|||||||
(do (adv!) (list (quote continue))))
|
(do (adv!) (list (quote continue))))
|
||||||
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
||||||
(do (adv!) (list (quote exit))))
|
(do (adv!) (list (quote exit))))
|
||||||
|
((and (= typ "keyword") (= val "js"))
|
||||||
|
(do (adv!) (parse-js-block)))
|
||||||
(true (parse-expr))))))
|
(true (parse-expr))))))
|
||||||
(define
|
(define
|
||||||
parse-cmd-list
|
parse-cmd-list
|
||||||
@@ -2710,7 +2739,8 @@
|
|||||||
(= v "close")
|
(= v "close")
|
||||||
(= v "pick")
|
(= v "pick")
|
||||||
(= v "ask")
|
(= v "ask")
|
||||||
(= v "answer"))))
|
(= v "answer")
|
||||||
|
(= v "js"))))
|
||||||
(define
|
(define
|
||||||
cl-collect
|
cl-collect
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -2588,3 +2588,21 @@
|
|||||||
node
|
node
|
||||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||||
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
(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)))))
|
||||||
|
|||||||
@@ -13636,5 +13636,12 @@ end")
|
|||||||
;; ── worker (1 tests) ──
|
;; ── worker (1 tests) ──
|
||||||
(defsuite "hs-upstream-worker"
|
(defsuite "hs-upstream-worker"
|
||||||
(deftest "raises a helpful error when the worker plugin is not installed"
|
(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")))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -568,6 +568,41 @@ K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[];
|
|||||||
K.registerNative('host-await',a=>{});
|
K.registerNative('host-await',a=>{});
|
||||||
K.registerNative('load-library!',()=>false);
|
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;
|
let _testDeadline = 0;
|
||||||
// Mock fetch routes
|
// Mock fetch routes
|
||||||
const _fetchRoutes = {
|
const _fetchRoutes = {
|
||||||
|
|||||||
@@ -155,6 +155,15 @@ MANUAL_TEST_BODIES = {
|
|||||||
' (assert-contains "foo" _names)',
|
' (assert-contains "foo" _names)',
|
||||||
' (assert-contains "bar" _values))',
|
' (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")))',
|
||||||
|
],
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user