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

HS tests: VM step limit fix, callFn error propagation, compiler emit-set fixes

Browse Source 
- sx_vm.ml: VM timeout now compares vm_insn_count > step_limit instead of
  unconditionally throwing after 65536 instructions when limit > 0
- sx_browser.ml: Expose setStepLimit/resetStepCount APIs on SxKernel;
  callFn now returns {__sx_error, message} on Eval_error instead of null
- compiler.sx: emit-set handles array-index targets (host-set! instead of
  nth) and 'of' property chains (dom-set-prop with chain navigation)
- hs-run-fast.js: New Node.js test runner with step-limit timeouts,
  SX-level guard for error detection, insertAdjacentHTML mock,
  range selection (HS_START/HS_END), wall-clock timeout in driveAsync
- hs-debug-test.js: Single-test debugger with DOM state inspection
- hs-verify.js: Assertion verification (proves pass/fail detection works)

Test results: 415/831 (50%), up from 408/831 (49%) baseline.
Fixes: set my style["color"], set X of Y, put at end of (insertAdjacentHTML).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-14 19:27:03 +00:00
parent b81c26c45b
commit b1666a5fe2
8 changed files with 3132 additions and 2293 deletions
Download Patch File Download Diff File Expand all files Collapse all files

88
lib/hyperscript/compiler.sx
View File

@@ -49,6 +49,34 @@
((= th (quote it)) (list (quote set!) (quote it) value))
((= th (quote query))
(list (quote dom-set-inner-html) (hs-to-sx target) value))
((= th (quote array-index))
(list
(quote host-set!)
(hs-to-sx (nth target 1))
(hs-to-sx (nth target 2))
value))
((= th (quote of))
;; Decompose (of prop-expr target) into a set operation
;; e.g. (of (. (ref "parentNode") "innerHTML") (query "#d1"))
;; → set parentNode.innerHTML of #d1 → need to navigate target, then set final prop
(let ((prop-ast (nth target 1))
(obj-ast (nth target 2)))
(if (and (list? prop-ast) (= (first prop-ast) dot-sym))
;; (. base "prop") of obj → (dom-set-prop (host-get (compiled-obj) (compiled-base-name)) "prop" value)
(let ((base (nth prop-ast 1))
(prop-name (nth prop-ast 2)))
(list (quote dom-set-prop)
(list (quote host-get) (hs-to-sx obj-ast) (nth base 1))
prop-name
value))
;; Simple: (ref "prop") of obj → (dom-set-prop (compiled-obj) "prop" value)
(if (and (list? prop-ast) (= (first prop-ast) (quote ref)))
(list (quote dom-set-prop)
(hs-to-sx obj-ast)
(nth prop-ast 1)
value)
;; Fallback
(list (quote set!) (hs-to-sx target) value)))))
(true (list (quote set!) (hs-to-sx target) value)))))))
(define
emit-on
@@ -237,25 +265,16 @@
(fn
(ast)
(let
((prop (nth ast 1)) (value (hs-to-sx (nth ast 2))))
(if
(= (len ast) 5)
(let
((raw-tgt (nth ast 4)))
(list
(quote hs-transition)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
prop
value
(nth ast 3)))
(let
((raw-tgt (nth ast 3)))
(list
(quote hs-transition)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
prop
value
nil))))))
((prop (hs-to-sx (nth ast 1)))
(value (hs-to-sx (nth ast 2)))
(dur (nth ast 3))
(raw-tgt (nth ast 4)))
(list
(quote hs-transition)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
prop
value
(if dur (hs-to-sx dur) nil)))))
(define
emit-make
(fn
@@ -400,6 +419,10 @@
((head (first ast)))
(cond
((= head (quote null-literal)) nil)
((= head (quote not))
(list (quote not) (hs-to-sx (nth ast 1))))
((or (= head (quote starts-with?)) (= head (quote ends-with?)) (= head (quote contains?)) (= head (quote matches?)) (= head (quote precedes?)) (= head (quote follows?)) (= head (quote exists?)))
(cons head (map hs-to-sx (rest ast))))
((= head (quote object-literal))
(let
((pairs (nth ast 1)))
@@ -935,20 +958,26 @@
((= head (quote transition)) (emit-transition ast))
((= head (quote transition-from))
(let
((prop (nth ast 1))
((prop (hs-to-sx (nth ast 1)))
(from-val (hs-to-sx (nth ast 2)))
(to-val (hs-to-sx (nth ast 3)))
(dur (nth ast 4)))
(dur (nth ast 4))
(raw-tgt (nth ast 5)))
(list
(quote hs-transition-from)
(quote me)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
prop
from-val
to-val
dur)))
(if dur (hs-to-sx dur) nil))))
((= head (quote repeat)) (emit-repeat ast))
((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
((= head (quote fetch-gql))
(list
(quote hs-fetch-gql)
(nth ast 1)
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
((= head (quote call))
(let
((fn-expr (hs-to-sx (nth ast 1)))
@@ -967,10 +996,15 @@
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 1))))
((= head (quote tell))
(list
(quote let)
(list (list (quote me) (hs-to-sx (nth ast 1))))
(hs-to-sx (nth ast 2))))
(let
((tgt (hs-to-sx (nth ast 1))))
(list
(quote let)
(list
(list (quote me) tgt)
(list (quote you) tgt)
(list (quote yourself) tgt))
(hs-to-sx (nth ast 2)))))
((= head (quote for)) (emit-for ast))
((= head (quote take!))
(let