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

Add 5 MCP tools, refactor nav-data, fix deep path bug, fix Playwright failures

Browse Source 
Nav refactoring:
- Split nav-data.sx (32 forms) into 6 files: nav-geography, nav-language,
  nav-applications, nav-etc, nav-tools, nav-tree
- Add Tools top-level nav category with SX Tools and Services pages
- New services-tools.sx page documenting the rose-ash-services MCP server

JS build fixes (fixes 5 Playwright failures):
- Wire web/web-signals.sx into JS build (stores, events, resources)
- Add cek-try primitive to JS platform (island hydration error handling)
- Merge PRIMITIVES into getRenderEnv (island env was missing primitives)
- Rename web/signals.sx → web/web-signals.sx to avoid spec/ collision

New MCP tools:
- sx_trace: step-through CEK evaluation showing lookups, calls, returns
- sx_deps: dependency analysis — free symbols + cross-file resolution
- sx_build_manifest: show build contents for JS and OCaml targets
- sx_harness_eval extended: multi-file loading + setup expressions

Deep path bug fix:
- Native OCaml list-replace and navigate bypass CEK callback chain
- Fixes sx_replace_node and sx_read_subtree corruption on paths 6+ deep

Tests: 1478/1478 JS full suite, 91/91 Playwright

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-26 12:09:22 +00:00
parent 4e88b8a9dd
commit 5ed984e7e3
18 changed files with 3620 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
lib/tests/test-tree-tools.sx
View File

@@ -672,4 +672,81 @@
(assert (not (nil? (get result "ok"))))
(let ((found (find-all (get result "ok") "second")))
(assert (>= (len found) 1))))))
)
(deftest "replace-node 6-level deep preserves full tree"
(let ((tree (sx-parse "(outer (a (b (c (d (e x y z) f g h i j k l) m n) o p) q r) s t)")))
(let ((result (replace-node tree (list 0 1 1 1 1 1 1) "replaced")))
(assert (not (nil? (get result "ok"))))
(let ((new-tree (get result "ok")))
(assert-equal "replaced" (symbol-name (navigate new-tree (list 0 1 1 1 1 1 1))))
(assert-equal 1 (len new-tree))
(let ((d-node (navigate new-tree (list 0 1 1 1 1))))
(assert-equal 9 (len d-node)))
(assert-equal "s" (symbol-name (navigate new-tree (list 0 2))))))))
(deftest "collect-free-symbols: let binds exclude variables"
(let ((tree (sx-parse "(let ((x 10)) (+ x y))")))
(let ((syms (collect-free-symbols (first tree))))
(assert (contains? syms "+"))
(assert (contains? syms "y"))
(assert (not (contains? syms "x"))))))
(deftest "collect-free-symbols: fn params excluded"
(let ((tree (sx-parse "(fn (a b) (+ a b c))")))
(let ((syms (collect-free-symbols (first tree))))
(assert (contains? syms "+"))
(assert (contains? syms "c"))
(assert (not (contains? syms "a")))
(assert (not (contains? syms "b"))))))
(deftest "collect-free-symbols: define name excluded"
(let ((tree (sx-parse "(define foo (+ bar 1))")))
(let ((syms (collect-free-symbols (first tree))))
(assert (contains? syms "+"))
(assert (contains? syms "bar"))
(assert (not (contains? syms "foo"))))))
(deftest "collect-free-symbols: letrec bindings visible in body"
(let ((tree (sx-parse "(letrec ((f (fn (x) (g x))) (g (fn (y) y))) (f 1))")))
(let ((syms (collect-free-symbols (first tree))))
(assert (not (contains? syms "f")))
(assert (not (contains? syms "g")))
(assert (not (contains? syms "x")))
(assert (not (contains? syms "y"))))))
(deftest "collect-free-symbols: quote skipped"
(let ((tree (sx-parse "(quote (foo bar baz))")))
(let ((syms (collect-free-symbols (first tree))))
(assert (empty? syms)))))
(deftest "collect-free-symbols: special forms not reported"
(let ((tree (sx-parse "(if (> x 0) (+ x 1) 0)")))
(let ((syms (collect-free-symbols (first tree))))
(assert (not (contains? syms "if")))
(assert (contains? syms ">"))
(assert (contains? syms "x"))
(assert (contains? syms "+")))))
(deftest "collect-free-symbols: defcomp params excluded"
(let ((tree (sx-parse "(defcomp ~card (&key title) (div title))")))
(let ((syms (collect-free-symbols (first tree))))
(assert (contains? syms "div"))
(assert (not (contains? syms "title"))))))
(deftest "native list-replace works at all positions"
(assert-equal (list 99 2 3) (list-replace (list 1 2 3) 0 99))
(assert-equal (list 1 99 3) (list-replace (list 1 2 3) 1 99))
(assert-equal (list 1 2 99) (list-replace (list 1 2 3) 2 99)))
(deftest "native navigate deep path"
(let ((tree (sx-parse "(a (b (c (d (e (f target))))))")))
(let ((result (navigate tree (list 0 1 1 1 1 1 1))))
(assert-equal "target" (symbol-name result)))))
(deftest "native navigate preserves structure"
(let ((tree (sx-parse "(outer (inner x y z) sibling)")))
(assert-equal "inner" (symbol-name (first (navigate tree (list 0 1)))))
(assert-equal "sibling" (symbol-name (navigate tree (list 0 2))))))
)