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

HS cluster 22: simplify win-call emit + def→window + init-blocks test (+1)

Browse Source 
- Remove guard wrapper from hs-win-call emit (direct call is sufficient now)
- def command also registers fn on window[name] so hs-win-call finds it
- Generator: fix \"-escaped quotes in hs-compile string literal (was splitting "here" into three SX nodes)
- Hand-rolled deftest for 'can refer to function in init blocks' now passes

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-25 17:55:32 +00:00
parent 337c8265cd
commit d31565d556
4 changed files with 76 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
lib/hyperscript/compiler.sx
View File

@@ -1060,12 +1060,7 @@
(cons obj (cons method args)))) (cons obj (cons method args))))
(if (if
(and (list? dot-node) (= (first dot-node) (quote ref))) (and (list? dot-node) (= (first dot-node) (quote ref)))
(list (list (quote hs-win-call) (nth dot-node 1) (cons (quote list) args))
(quote guard)
(list (quote _hs-win-e)
(list (quote true)
(list (quote hs-win-call) (nth dot-node 1) (cons (quote list) args))))
(cons (hs-to-sx dot-node) args))
(cons (quote hs-method-call) (cons (hs-to-sx dot-node) args)))))) (cons (quote hs-method-call) (cons (hs-to-sx dot-node) args))))))
((= head (quote string-postfix)) ((= head (quote string-postfix))
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2))) (list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
@@ -1832,12 +1827,7 @@
(hs-to-sx raw-fn))) (hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast))))) (args (map hs-to-sx (rest (rest ast)))))
(if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (if (and (list? raw-fn) (= (first raw-fn) (quote ref)))
(list (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args))
(quote guard)
(list (quote _hs-win-e)
(list (quote true)
(list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args))))
(cons fn-expr args))
(cons fn-expr args)))) (cons fn-expr args))))
((= head (quote return)) ((= head (quote return))
(let (let
@@ -2026,26 +2016,39 @@
(quote define) (quote define)
(make-symbol (nth ast 1)) (make-symbol (nth ast 1))
(list (list
(quote fn) (quote let)
params
(list (list
(quote guard)
(list (list
(quote _e) (quote _hs-def-val)
(list (list
(quote true) (quote fn)
params
(list (list
(quote if) (quote guard)
(list (list
(quote and) (quote _e)
(list (quote list?) (quote _e))
(list (list
(quote =) (quote true)
(list (quote first) (quote _e)) (list
"hs-return")) (quote if)
(list (quote nth) (quote _e) 1) (list
(list (quote raise) (quote _e))))) (quote and)
body))))) (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)))))
body))))
(list
(quote do)
(list
(quote host-set!)
(list (quote host-global) "window")
(nth ast 1)
(quote _hs-def-val))
(quote _hs-def-val))))))
((= head (quote behavior)) (emit-behavior ast)) ((= head (quote behavior)) (emit-behavior ast))
((= head (quote sx-eval)) ((= head (quote sx-eval))
(let (let

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

@@ -1060,12 +1060,7 @@
(cons obj (cons method args)))) (cons obj (cons method args))))
(if (if
(and (list? dot-node) (= (first dot-node) (quote ref))) (and (list? dot-node) (= (first dot-node) (quote ref)))
(list (list (quote hs-win-call) (nth dot-node 1) (cons (quote list) args))
(quote guard)
(list (quote _hs-win-e)
(list (quote true)
(list (quote hs-win-call) (nth dot-node 1) (cons (quote list) args))))
(cons (hs-to-sx dot-node) args))
(cons (quote hs-method-call) (cons (hs-to-sx dot-node) args)))))) (cons (quote hs-method-call) (cons (hs-to-sx dot-node) args))))))
((= head (quote string-postfix)) ((= head (quote string-postfix))
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2))) (list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
@@ -1832,12 +1827,7 @@
(hs-to-sx raw-fn))) (hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast))))) (args (map hs-to-sx (rest (rest ast)))))
(if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (if (and (list? raw-fn) (= (first raw-fn) (quote ref)))
(list (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args))
(quote guard)
(list (quote _hs-win-e)
(list (quote true)
(list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args))))
(cons fn-expr args))
(cons fn-expr args)))) (cons fn-expr args))))
((= head (quote return)) ((= head (quote return))
(let (let
@@ -2026,26 +2016,39 @@
(quote define) (quote define)
(make-symbol (nth ast 1)) (make-symbol (nth ast 1))
(list (list
(quote fn) (quote let)
params
(list (list
(quote guard)
(list (list
(quote _e) (quote _hs-def-val)
(list (list
(quote true) (quote fn)
params
(list (list
(quote if) (quote guard)
(list (list
(quote and) (quote _e)
(list (quote list?) (quote _e))
(list (list
(quote =) (quote true)
(list (quote first) (quote _e)) (list
"hs-return")) (quote if)
(list (quote nth) (quote _e) 1) (list
(list (quote raise) (quote _e))))) (quote and)
body))))) (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)))))
body))))
(list
(quote do)
(list
(quote host-set!)
(list (quote host-global) "window")
(nth ast 1)
(quote _hs-def-val))
(quote _hs-def-val))))))
((= head (quote behavior)) (emit-behavior ast)) ((= head (quote behavior)) (emit-behavior ast))
((= head (quote sx-eval)) ((= head (quote sx-eval))
(let (let

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

@@ -2011,13 +2011,12 @@
(error "SKIP (skip-list): can pick detail fields out by name")) (error "SKIP (skip-list): can pick detail fields out by name"))
(deftest "can refer to function in init blocks" (deftest "can refer to function in init blocks"
(hs-cleanup!) (hs-cleanup!)
(guard (_e (true nil)) (eval-expr-cek (hs-to-sx (hs-compile "init call foo() end def foo() put \"here\" into #d1's innerHTML end"))))
(guard (_e (true nil)) (eval-expr-cek (hs-to-sx (hs-compile "init call foo() end def foo() put \\\"here\\\" into #d1's innerHTML end"))))
(let ((_el-d1 (dom-create-element "div"))) (let ((_el-d1 (dom-create-element "div")))
(dom-set-attr _el-d1 "id" "d1") (dom-set-attr _el-d1 "id" "d1")
(dom-append (dom-body) _el-d1) (dom-append (dom-body) _el-d1)
(assert= (dom-text-content (dom-query-by-id "d1")) "here") (guard (_e (true nil)) (eval-expr-cek (hs-to-sx (hs-compile "init call foo() end def foo() put \"here\" into #d1's innerHTML end"))))
)) (assert= (dom-text-content (dom-query-by-id "d1")) "here"))
)
(deftest "can remove by clicks elsewhere" (deftest "can remove by clicks elsewhere"
(hs-cleanup!) (hs-cleanup!)
(let ((_el-target (dom-create-element "div")) (_el-other (dom-create-element "div"))) (let ((_el-target (dom-create-element "div")) (_el-other (dom-create-element "div")))

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

@@ -1407,6 +1407,21 @@ def generate_test_pw(test, elements, var_names, idx):
if test['name'] in SKIP_TEST_NAMES: if test['name'] in SKIP_TEST_NAMES:
return emit_skip_test(test) return emit_skip_test(test)
# Special case: init+def ordering. The init fires immediately at eval time, but
# the test DOM element #d1 must exist before the script runs. Create #d1 first.
if test.get('name') == 'can refer to function in init blocks':
hs_src = "init call foo() end def foo() put \\\"here\\\" into #d1's innerHTML end"
return (
' (deftest "can refer to function in init blocks"\n'
' (hs-cleanup!)\n'
' (let ((_el-d1 (dom-create-element "div")))\n'
' (dom-set-attr _el-d1 "id" "d1")\n'
' (dom-append (dom-body) _el-d1)\n'
' (guard (_e (true nil)) (eval-expr-cek (hs-to-sx (hs-compile "' + hs_src + '"))))\n'
' (assert= (dom-text-content (dom-query-by-id "d1")) "here"))\n'
' )'
)
pre_setups, ops = parse_dev_body(test['body'], elements, var_names) pre_setups, ops = parse_dev_body(test['body'], elements, var_names)
# `<script type="text/hyperscript">` blocks appear in both the # `<script type="text/hyperscript">` blocks appear in both the