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

hs: call command binds result to it via emit-set

Browse Source 
call X then put it into Y was emitting (hs-win-call ...) without
wrapping in emit-set, so it remained nil. Wrap call result in
emit-set(the-result) so it/the-result are updated. Fixes +1 test.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-26 14:14:02 +00:00
parent 037acc7998
commit 35f498ec80
2 changed files with 2828 additions and 2718 deletions
Download Patch File Download Diff File Expand all files Collapse all files

115
lib/hyperscript/compiler.sx
View File

@@ -789,7 +789,8 @@
(cons (quote do) (map hs-to-sx body))))))) (cons (quote do) (map hs-to-sx body)))))))
(fn (fn
(ast) (ast)
(let ((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast))) (let
((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
(cond (cond
((nil? ast) nil) ((nil? ast) nil)
((number? ast) ast) ((number? ast) ast)
@@ -910,7 +911,8 @@
(append (append
parts parts
(list (list
(hs-to-sx (hs-compile expr-src))))) (hs-to-sx
(hs-compile expr-src)))))
(set! i (+ close 1)) (set! i (+ close 1))
(tpl-collect))))) (tpl-collect)))))
(let (let
@@ -1185,7 +1187,10 @@
((left (nth ast 1)) (right (nth ast 2))) ((left (nth ast 1)) (right (nth ast 2)))
(if (if
(and (list? right) (= (first right) (quote query))) (and (list? right) (= (first right) (quote query)))
(list (quote hs-matches?) (hs-to-sx left) (nth right 1)) (list
(quote hs-matches?)
(hs-to-sx left)
(nth right 1))
(list (list
(quote hs-matches?) (quote hs-matches?)
(hs-to-sx left) (hs-to-sx left)
@@ -1236,7 +1241,10 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))) (hs-to-sx (nth ast 2))))
((= head (quote as)) ((= head (quote as))
(list (quote hs-coerce) (hs-to-sx (nth ast 1)) (nth ast 2))) (list
(quote hs-coerce)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote in?)) ((= head (quote in?))
(list (list
(quote hs-in?) (quote hs-in?)
@@ -1313,19 +1321,27 @@
((= head (quote last)) ((= head (quote last))
(if (if
(> (len ast) 2) (> (len ast) 2)
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1)) (list
(quote hs-last)
(hs-to-sx (nth ast 2))
(nth ast 1))
(list (quote hs-query-last) (nth ast 1)))) (list (quote hs-query-last) (nth ast 1))))
((= head (quote add-class)) ((= head (quote add-class))
(let (let
((raw-tgt (nth ast 2))) ((raw-tgt (nth ast 2)))
(if (if
(and (list? raw-tgt) (= (first raw-tgt) (quote query))) (and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list (list
(quote for-each) (quote for-each)
(list (list
(quote fn) (quote fn)
(list (quote _el)) (list (quote _el))
(list (quote dom-add-class) (quote _el) (nth ast 1))) (list
(quote dom-add-class)
(quote _el)
(nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1))) (list (quote hs-query-all) (nth raw-tgt 1)))
(list (list
(quote dom-add-class) (quote dom-add-class)
@@ -1345,7 +1361,11 @@
(map (map
(fn (fn
(p) (p)
(list (quote dom-set-style) tgt (first p) (nth p 1))) (list
(quote dom-set-style)
tgt
(first p)
(nth p 1)))
pairs)))) pairs))))
((= head (quote multi-add-class)) ((= head (quote multi-add-class))
(let (let
@@ -1381,7 +1401,10 @@
(quote set!) (quote set!)
(quote the-result) (quote the-result)
(quote __hs-matched)) (quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched)) (list
(quote set!)
(quote it)
(quote __hs-matched))
(list (list
(quote for-each) (quote for-each)
(list (list
@@ -1416,7 +1439,10 @@
(quote set!) (quote set!)
(quote the-result) (quote the-result)
(quote __hs-matched)) (quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched)) (list
(quote set!)
(quote it)
(quote __hs-matched))
(list (list
(quote for-each) (quote for-each)
(list (list
@@ -1436,13 +1462,17 @@
(cons (cons
(quote do) (quote do)
(map (map
(fn (cls) (list (quote dom-remove-class) target cls)) (fn
(cls)
(list (quote dom-remove-class) target cls))
classes)))) classes))))
((= head (quote remove-class)) ((= head (quote remove-class))
(let (let
((raw-tgt (nth ast 2))) ((raw-tgt (nth ast 2)))
(if (if
(and (list? raw-tgt) (= (first raw-tgt) (quote query))) (and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list (list
(quote for-each) (quote for-each)
(list (list
@@ -1463,7 +1493,8 @@
(cond (cond
((and (list? tgt) (= (first tgt) (quote array-index))) ((and (list? tgt) (= (first tgt) (quote array-index)))
(let (let
((coll (nth tgt 1)) (idx (hs-to-sx (nth tgt 2)))) ((coll (nth tgt 1))
(idx (hs-to-sx (nth tgt 2))))
(emit-set (emit-set
coll coll
(list (quote hs-splice-at!) (hs-to-sx coll) idx)))) (list (quote hs-splice-at!) (hs-to-sx coll) idx))))
@@ -1472,7 +1503,10 @@
((obj (nth tgt 1)) (prop (nth tgt 2))) ((obj (nth tgt 1)) (prop (nth tgt 2)))
(emit-set (emit-set
obj obj
(list (quote hs-dict-without) (hs-to-sx obj) prop)))) (list
(quote hs-dict-without)
(hs-to-sx obj)
prop))))
((and (list? tgt) (= (first tgt) (quote of))) ((and (list? tgt) (= (first tgt) (quote of)))
(let (let
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2))) ((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
@@ -1669,8 +1703,13 @@
((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref)))) ((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref))))
(emit-set (emit-set
raw-tgt raw-tgt
(list (quote hs-put-at!) val pos (hs-to-sx raw-tgt)))) (list
(true (list (quote hs-put!) val pos (hs-to-sx raw-tgt)))))) (quote hs-put-at!)
val
pos
(hs-to-sx raw-tgt))))
(true
(list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
((= head (quote if)) ((= head (quote if))
(if (if
(> (len ast) 3) (> (len ast) 3)
@@ -1833,7 +1872,10 @@
(list (quote fn) (list) (hs-to-sx (nth ast 1))) (list (quote fn) (list) (hs-to-sx (nth ast 1)))
(list (quote fn) (list) (hs-to-sx (nth ast 2))))) (list (quote fn) (list) (hs-to-sx (nth ast 2)))))
((= head (quote fetch)) ((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) (list
(quote hs-fetch)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote fetch-gql)) ((= head (quote fetch-gql))
(list (list
(quote hs-fetch-gql) (quote hs-fetch-gql)
@@ -1848,19 +1890,17 @@
(make-symbol raw-fn) (make-symbol raw-fn)
(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 (let
(and (list? raw-fn) (= (first raw-fn) (quote ref))) ((call-expr (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args))))
(list (emit-set (quote the-result) call-expr))))
(quote hs-win-call)
(nth raw-fn 1)
(cons (quote list) args))
(cons fn-expr args))))
((= head (quote return)) ((= head (quote return))
(let (let
((val (nth ast 1))) ((val (nth ast 1)))
(if (if
(nil? val) (nil? val)
(list (quote raise) (list (quote list) "hs-return" nil)) (list
(quote raise)
(list (quote list) "hs-return" nil))
(list (list
(quote raise) (quote raise)
(list (quote list) "hs-return" (hs-to-sx val)))))) (list (quote list) "hs-return" (hs-to-sx val))))))
@@ -1878,7 +1918,10 @@
(list (list (quote __hs-a) val)) (list (list (quote __hs-a) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-a)) (list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a)) (list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a))))) (quote __hs-a)))))
((= head (quote answer)) ((= head (quote answer))
@@ -1889,7 +1932,10 @@
(list (list (quote __hs-a) val)) (list (list (quote __hs-a) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-a)) (list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a)) (list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a))))) (quote __hs-a)))))
((= head (quote answer-alert)) ((= head (quote answer-alert))
@@ -1900,7 +1946,10 @@
(list (list (quote __hs-a) val)) (list (list (quote __hs-a) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-a)) (list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a)) (list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a))))) (quote __hs-a)))))
((= head (quote __get-cmd)) ((= head (quote __get-cmd))
@@ -1911,7 +1960,10 @@
(list (list (quote __hs-g) val)) (list (list (quote __hs-g) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-g)) (list
(quote set!)
(quote the-result)
(quote __hs-g))
(list (quote set!) (quote it) (quote __hs-g)) (list (quote set!) (quote it) (quote __hs-g))
(quote __hs-g))))) (quote __hs-g)))))
((= head (quote append!)) ((= head (quote append!))
@@ -2202,7 +2254,10 @@
(list (list
(quote hs-is) (quote hs-is)
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2))) (list
(quote fn)
(list)
(hs-to-sx (nth (nth ast 2) 2)))
(nth ast 3))) (nth ast 3)))
((= head (quote halt!)) ((= head (quote halt!))
(list (quote hs-halt!) (quote event) (nth ast 1))) (list (quote hs-halt!) (quote event) (nth ast 1)))

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

@@ -789,7 +789,8 @@
(cons (quote do) (map hs-to-sx body))))))) (cons (quote do) (map hs-to-sx body)))))))
(fn (fn
(ast) (ast)
(let ((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast))) (let
((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
(cond (cond
((nil? ast) nil) ((nil? ast) nil)
((number? ast) ast) ((number? ast) ast)
@@ -910,7 +911,8 @@
(append (append
parts parts
(list (list
(hs-to-sx (hs-compile expr-src))))) (hs-to-sx
(hs-compile expr-src)))))
(set! i (+ close 1)) (set! i (+ close 1))
(tpl-collect))))) (tpl-collect)))))
(let (let
@@ -1185,7 +1187,10 @@
((left (nth ast 1)) (right (nth ast 2))) ((left (nth ast 1)) (right (nth ast 2)))
(if (if
(and (list? right) (= (first right) (quote query))) (and (list? right) (= (first right) (quote query)))
(list (quote hs-matches?) (hs-to-sx left) (nth right 1)) (list
(quote hs-matches?)
(hs-to-sx left)
(nth right 1))
(list (list
(quote hs-matches?) (quote hs-matches?)
(hs-to-sx left) (hs-to-sx left)
@@ -1236,7 +1241,10 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))) (hs-to-sx (nth ast 2))))
((= head (quote as)) ((= head (quote as))
(list (quote hs-coerce) (hs-to-sx (nth ast 1)) (nth ast 2))) (list
(quote hs-coerce)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote in?)) ((= head (quote in?))
(list (list
(quote hs-in?) (quote hs-in?)
@@ -1313,19 +1321,27 @@
((= head (quote last)) ((= head (quote last))
(if (if
(> (len ast) 2) (> (len ast) 2)
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1)) (list
(quote hs-last)
(hs-to-sx (nth ast 2))
(nth ast 1))
(list (quote hs-query-last) (nth ast 1)))) (list (quote hs-query-last) (nth ast 1))))
((= head (quote add-class)) ((= head (quote add-class))
(let (let
((raw-tgt (nth ast 2))) ((raw-tgt (nth ast 2)))
(if (if
(and (list? raw-tgt) (= (first raw-tgt) (quote query))) (and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list (list
(quote for-each) (quote for-each)
(list (list
(quote fn) (quote fn)
(list (quote _el)) (list (quote _el))
(list (quote dom-add-class) (quote _el) (nth ast 1))) (list
(quote dom-add-class)
(quote _el)
(nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1))) (list (quote hs-query-all) (nth raw-tgt 1)))
(list (list
(quote dom-add-class) (quote dom-add-class)
@@ -1345,7 +1361,11 @@
(map (map
(fn (fn
(p) (p)
(list (quote dom-set-style) tgt (first p) (nth p 1))) (list
(quote dom-set-style)
tgt
(first p)
(nth p 1)))
pairs)))) pairs))))
((= head (quote multi-add-class)) ((= head (quote multi-add-class))
(let (let
@@ -1381,7 +1401,10 @@
(quote set!) (quote set!)
(quote the-result) (quote the-result)
(quote __hs-matched)) (quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched)) (list
(quote set!)
(quote it)
(quote __hs-matched))
(list (list
(quote for-each) (quote for-each)
(list (list
@@ -1416,7 +1439,10 @@
(quote set!) (quote set!)
(quote the-result) (quote the-result)
(quote __hs-matched)) (quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched)) (list
(quote set!)
(quote it)
(quote __hs-matched))
(list (list
(quote for-each) (quote for-each)
(list (list
@@ -1436,13 +1462,17 @@
(cons (cons
(quote do) (quote do)
(map (map
(fn (cls) (list (quote dom-remove-class) target cls)) (fn
(cls)
(list (quote dom-remove-class) target cls))
classes)))) classes))))
((= head (quote remove-class)) ((= head (quote remove-class))
(let (let
((raw-tgt (nth ast 2))) ((raw-tgt (nth ast 2)))
(if (if
(and (list? raw-tgt) (= (first raw-tgt) (quote query))) (and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list (list
(quote for-each) (quote for-each)
(list (list
@@ -1463,7 +1493,8 @@
(cond (cond
((and (list? tgt) (= (first tgt) (quote array-index))) ((and (list? tgt) (= (first tgt) (quote array-index)))
(let (let
((coll (nth tgt 1)) (idx (hs-to-sx (nth tgt 2)))) ((coll (nth tgt 1))
(idx (hs-to-sx (nth tgt 2))))
(emit-set (emit-set
coll coll
(list (quote hs-splice-at!) (hs-to-sx coll) idx)))) (list (quote hs-splice-at!) (hs-to-sx coll) idx))))
@@ -1472,7 +1503,10 @@
((obj (nth tgt 1)) (prop (nth tgt 2))) ((obj (nth tgt 1)) (prop (nth tgt 2)))
(emit-set (emit-set
obj obj
(list (quote hs-dict-without) (hs-to-sx obj) prop)))) (list
(quote hs-dict-without)
(hs-to-sx obj)
prop))))
((and (list? tgt) (= (first tgt) (quote of))) ((and (list? tgt) (= (first tgt) (quote of)))
(let (let
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2))) ((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
@@ -1669,8 +1703,13 @@
((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref)))) ((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref))))
(emit-set (emit-set
raw-tgt raw-tgt
(list (quote hs-put-at!) val pos (hs-to-sx raw-tgt)))) (list
(true (list (quote hs-put!) val pos (hs-to-sx raw-tgt)))))) (quote hs-put-at!)
val
pos
(hs-to-sx raw-tgt))))
(true
(list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
((= head (quote if)) ((= head (quote if))
(if (if
(> (len ast) 3) (> (len ast) 3)
@@ -1833,7 +1872,10 @@
(list (quote fn) (list) (hs-to-sx (nth ast 1))) (list (quote fn) (list) (hs-to-sx (nth ast 1)))
(list (quote fn) (list) (hs-to-sx (nth ast 2))))) (list (quote fn) (list) (hs-to-sx (nth ast 2)))))
((= head (quote fetch)) ((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) (list
(quote hs-fetch)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote fetch-gql)) ((= head (quote fetch-gql))
(list (list
(quote hs-fetch-gql) (quote hs-fetch-gql)
@@ -1848,19 +1890,17 @@
(make-symbol raw-fn) (make-symbol raw-fn)
(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 (let
(and (list? raw-fn) (= (first raw-fn) (quote ref))) ((call-expr (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args))))
(list (emit-set (quote the-result) call-expr))))
(quote hs-win-call)
(nth raw-fn 1)
(cons (quote list) args))
(cons fn-expr args))))
((= head (quote return)) ((= head (quote return))
(let (let
((val (nth ast 1))) ((val (nth ast 1)))
(if (if
(nil? val) (nil? val)
(list (quote raise) (list (quote list) "hs-return" nil)) (list
(quote raise)
(list (quote list) "hs-return" nil))
(list (list
(quote raise) (quote raise)
(list (quote list) "hs-return" (hs-to-sx val)))))) (list (quote list) "hs-return" (hs-to-sx val))))))
@@ -1878,7 +1918,10 @@
(list (list (quote __hs-a) val)) (list (list (quote __hs-a) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-a)) (list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a)) (list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a))))) (quote __hs-a)))))
((= head (quote answer)) ((= head (quote answer))
@@ -1889,7 +1932,10 @@
(list (list (quote __hs-a) val)) (list (list (quote __hs-a) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-a)) (list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a)) (list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a))))) (quote __hs-a)))))
((= head (quote answer-alert)) ((= head (quote answer-alert))
@@ -1900,7 +1946,10 @@
(list (list (quote __hs-a) val)) (list (list (quote __hs-a) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-a)) (list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a)) (list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a))))) (quote __hs-a)))))
((= head (quote __get-cmd)) ((= head (quote __get-cmd))
@@ -1911,7 +1960,10 @@
(list (list (quote __hs-g) val)) (list (list (quote __hs-g) val))
(list (list
(quote begin) (quote begin)
(list (quote set!) (quote the-result) (quote __hs-g)) (list
(quote set!)
(quote the-result)
(quote __hs-g))
(list (quote set!) (quote it) (quote __hs-g)) (list (quote set!) (quote it) (quote __hs-g))
(quote __hs-g))))) (quote __hs-g)))))
((= head (quote append!)) ((= head (quote append!))
@@ -2202,7 +2254,10 @@
(list (list
(quote hs-is) (quote hs-is)
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2))) (list
(quote fn)
(list)
(hs-to-sx (nth (nth ast 2) 2)))
(nth ast 3))) (nth ast 3)))
((= head (quote halt!)) ((= head (quote halt!))
(list (quote hs-halt!) (quote event) (nth ast 1))) (list (quote hs-halt!) (quote event) (nth ast 1)))