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

- 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:
2026-04-25 17:55:32 +00:00
parent 337c8265cd
commit d31565d556
4 changed files with 76 additions and 56 deletions

View File

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