From d31565d556fdca1d2eae98f7d0b1aa0637725699 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 17:55:32 +0000 Subject: [PATCH] =?UTF-8?q?HS=20cluster=2022:=20simplify=20win-call=20emit?= =?UTF-8?q?=20+=20def=E2=86=92window=20+=20init-blocks=20test=20(+1)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - 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 --- lib/hyperscript/compiler.sx | 55 ++++++++++++----------- shared/static/wasm/sx/hs-compiler.sx | 55 ++++++++++++----------- spec/tests/test-hyperscript-behavioral.sx | 7 ++- tests/playwright/generate-sx-tests.py | 15 +++++++ 4 files changed, 76 insertions(+), 56 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 1d17c214..c196eec6 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -1060,12 +1060,7 @@ (cons obj (cons method args)))) (if (and (list? dot-node) (= (first dot-node) (quote ref))) - (list - (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)) + (list (quote hs-win-call) (nth dot-node 1) (cons (quote list) args)) (cons (quote hs-method-call) (cons (hs-to-sx dot-node) args)))))) ((= head (quote string-postfix)) (list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2))) @@ -1832,12 +1827,7 @@ (hs-to-sx raw-fn))) (args (map hs-to-sx (rest (rest ast))))) (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) - (list - (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)) + (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args)))) ((= head (quote return)) (let @@ -2026,26 +2016,39 @@ (quote define) (make-symbol (nth ast 1)) (list - (quote fn) - params + (quote let) (list - (quote guard) (list - (quote _e) + (quote _hs-def-val) (list - (quote true) + (quote fn) + params (list - (quote if) + (quote guard) (list - (quote and) - (list (quote list?) (quote _e)) + (quote _e) (list - (quote =) - (list (quote first) (quote _e)) - "hs-return")) - (list (quote nth) (quote _e) 1) - (list (quote raise) (quote _e))))) - body))))) + (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))))) + 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 sx-eval)) (let diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index 1d17c214..c196eec6 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -1060,12 +1060,7 @@ (cons obj (cons method args)))) (if (and (list? dot-node) (= (first dot-node) (quote ref))) - (list - (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)) + (list (quote hs-win-call) (nth dot-node 1) (cons (quote list) args)) (cons (quote hs-method-call) (cons (hs-to-sx dot-node) args)))))) ((= head (quote string-postfix)) (list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2))) @@ -1832,12 +1827,7 @@ (hs-to-sx raw-fn))) (args (map hs-to-sx (rest (rest ast))))) (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) - (list - (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)) + (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args)))) ((= head (quote return)) (let @@ -2026,26 +2016,39 @@ (quote define) (make-symbol (nth ast 1)) (list - (quote fn) - params + (quote let) (list - (quote guard) (list - (quote _e) + (quote _hs-def-val) (list - (quote true) + (quote fn) + params (list - (quote if) + (quote guard) (list - (quote and) - (list (quote list?) (quote _e)) + (quote _e) (list - (quote =) - (list (quote first) (quote _e)) - "hs-return")) - (list (quote nth) (quote _e) 1) - (list (quote raise) (quote _e))))) - body))))) + (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))))) + 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 sx-eval)) (let diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index f0206746..555e4a31 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -2011,13 +2011,12 @@ (error "SKIP (skip-list): can pick detail fields out by name")) (deftest "can refer to function in init blocks" (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"))) (dom-set-attr _el-d1 "id" "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" (hs-cleanup!) (let ((_el-target (dom-create-element "div")) (_el-other (dom-create-element "div"))) diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index e3a032b1..73c4aa5c 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -1407,6 +1407,21 @@ def generate_test_pw(test, elements, var_names, idx): if test['name'] in SKIP_TEST_NAMES: 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) # `