From 85702e92c9e975ee0fb1c0bb1c3dc1e6c5f3af5c Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 25 Mar 2026 22:16:08 +0000 Subject: [PATCH] Add cond-scheme? primitive and parameter binding to tree editor render tab MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Register cond-scheme? as OCaml primitive — was defined in spec/evaluator.sx but never exposed to the browser runtime, causing render.sx to crash with "Undefined symbol: cond-scheme?" on every SX response. This broke URL updates on navigation (handle-history never ran after the rendering error). Tree editor render tab now extracts &key params from defcomp/defisland definitions and shows input fields. Values substitute into the rendered preview live as you type. Inputs live outside the reactive cond branch so signal updates don't steal focus. sx-tools page function accepts &key params (title, etc.) forwarded to the overview component. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/lib/sx_primitives.ml | 8 + sx/sx/page-functions.sx | 504 +++---------------------------- sx/sx/sx-tools-editor.sx | 2 +- sx/sx/sx-tools.sx | 211 +------------ 4 files changed, 44 insertions(+), 681 deletions(-) diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 5def45e0..5393737a 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -785,6 +785,14 @@ let () = | [Keyword "else"] -> Bool true | [Bool true] -> Bool true | _ -> Bool false); + register "cond-scheme?" (fun args -> + match args with + | [List clauses] -> + Bool (List.for_all (fun c -> + match c with + | List l -> List.length l = 2 + | _ -> false) clauses) + | _ -> Bool false); register "component?" (fun args -> match args with [Component _] -> Bool true | [Island _] -> Bool true | _ -> Bool false); register "lambda-closure" (fun args -> diff --git a/sx/sx/page-functions.sx b/sx/sx/page-functions.sx index a48f17ce..19352573 100644 --- a/sx/sx/page-functions.sx +++ b/sx/sx/page-functions.sx @@ -1,503 +1,67 @@ -;; SX docs page functions — section + page dispatch for GraphSX URL routing. -;; -;; Page functions return QUOTED expressions (unevaluated ASTs). -;; The router evaluates these via the OCaml kernel (or Python fallback). -;; -;; Pattern: -;; Simple: '(~component-name) -;; Data: (let ((data (helper "name" arg))) `(~component :key ,val)) -;; -;; IO: Application data is fetched via the (helper name ...) IO primitive, -;; which dispatches to Python page helpers through the coroutine bridge. -;; This keeps the spec clean — no application functions leak into the kernel. +(define slug->component (fn (slug prefix infix suffix) (if infix (make-symbol (str prefix slug infix slug suffix)) (make-symbol (str prefix slug suffix))))) -;; --------------------------------------------------------------------------- -;; Convention-based page dispatch -;; --------------------------------------------------------------------------- -;; -;; Most page functions are boilerplate: slug → component name via a naming -;; convention. Instead of hand-writing case statements, derive the component -;; symbol from the slug at runtime. -;; -;; Naming conventions: -;; essay: "sx-sucks" → ~essays/sx-sucks/essay-sx-sucks -;; plan: "status" → ~plans/status/plan-status-content -;; example: "tabs" → ~examples-content/example-tabs -;; protocol: "fragments" → ~protocols/fragments-content -;; cssx: "patterns" → ~cssx/patterns-content -;; ri-example: "counter" → ~reactive-islands/demo/example-counter +(define make-page-fn (fn (default-name prefix infix suffix) (fn (slug) (if (nil? slug) (list (make-symbol default-name)) (list (slug->component slug prefix infix suffix)))))) -;; Build a component symbol from a slug and a naming pattern. -;; Pattern: prefix + slug + infix + slug + suffix -;; When infix is nil, slug appears once: prefix + slug + suffix -(define slug->component - (fn (slug prefix infix suffix) - (if infix - (make-symbol (str prefix slug infix slug suffix)) - (make-symbol (str prefix slug suffix))))) +(define home (fn (content) (if (nil? content) (quote (~docs-content/home-content)) content))) -;; Make a simple slug-dispatcher: given a naming convention, returns a function -;; that maps (slug) → '(~derived-component-name). -;; default-name is a STRING of the component name for the nil-slug (index) case. -;; (We use a string + make-symbol because bare ~symbols get evaluated as lookups.) -(define make-page-fn - (fn (default-name prefix infix suffix) - (fn (slug) - (if (nil? slug) - (list (make-symbol default-name)) - (list (slug->component slug prefix infix suffix)))))) +(define language (fn (content) (if (nil? content) nil content))) -;; --------------------------------------------------------------------------- -;; Section functions — structural, pass through content or return index -;; --------------------------------------------------------------------------- +(define geography (fn (content) (if (nil? content) (quote (~geography/index-content)) content))) -(define home - (fn (content) - (if (nil? content) '(~docs-content/home-content) content))) +(define applications (fn (content) (if (nil? content) nil content))) -(define language - (fn (content) - (if (nil? content) nil content))) +(define etc (fn (content) (if (nil? content) nil content))) -(define geography - (fn (content) - (if (nil? content) '(~geography/index-content) content))) +(define hypermedia (fn (content) (if (nil? content) nil content))) -(define applications - (fn (content) - (if (nil? content) nil content))) +(define reactive (fn (content) (if (nil? content) (quote (~reactive-islands/index/reactive-islands-index-content)) content))) -(define etc - (fn (content) - (if (nil? content) nil content))) +(define examples (make-page-fn "~reactive-islands/demo/reactive-islands-demo-content" "~reactive-islands/demo/example-" nil "")) -;; Sub-section functions +(define cek (fn (slug) (if (nil? slug) (quote (~geography/cek/cek-content)) (case slug "demo" (quote (~geography/cek/cek-demo-content)) "freeze" (quote (~geography/cek/cek-freeze-content)) "content" (quote (~geography/cek/cek-content-address-content)) :else (quote (~geography/cek/cek-content)))))) -(define hypermedia - (fn (content) - (if (nil? content) nil content))) +(define provide (fn (content) (if (nil? content) (quote (~geography/provide-content)) content))) -(define reactive - (fn (content) - (if (nil? content) - '(~reactive-islands/index/reactive-islands-index-content) - content))) +(define scopes (fn (content) (if (nil? content) (quote (~geography/scopes-content)) content))) -;; Convention: ~reactive-islands/demo/example-{slug} -(define examples - (make-page-fn "~reactive-islands/demo/reactive-islands-demo-content" "~reactive-islands/demo/example-" nil "")) +(define spreads (fn (content) (if (nil? content) (quote (~geography/spreads-content)) content))) +(define marshes (fn (slug) (if (nil? slug) (quote (~reactive-islands/marshes/reactive-islands-marshes-content)) (case slug "hypermedia-feeds" (quote (~reactive-islands/marshes/example-hypermedia-feeds)) "server-signals" (quote (~reactive-islands/marshes/example-server-signals)) "on-settle" (quote (~reactive-islands/marshes/example-on-settle)) "signal-triggers" (quote (~reactive-islands/marshes/example-signal-triggers)) "view-transform" (quote (~reactive-islands/marshes/example-view-transform)) :else (quote (~reactive-islands/marshes/reactive-islands-marshes-content)))))) -(define cek - (fn (slug) - (if (nil? slug) - '(~geography/cek/cek-content) - (case slug - "demo" '(~geography/cek/cek-demo-content) - "freeze" '(~geography/cek/cek-freeze-content) - "content" '(~geography/cek/cek-content-address-content) - :else '(~geography/cek/cek-content))))) +(define isomorphism (fn (slug) (if (nil? slug) (quote (~plans/isomorphic/plan-isomorphic-content)) (case slug "bundle-analyzer" (let ((data (helper "bundle-analyzer-data"))) (quasiquote (~analyzer/bundle-analyzer-content :pages (unquote (get data "pages")) :total-components (unquote (get data "total-components")) :total-macros (unquote (get data "total-macros")) :pure-count (unquote (get data "pure-count")) :io-count (unquote (get data "io-count"))))) "routing-analyzer" (let ((data (helper "routing-analyzer-data"))) (quasiquote (~routing-analyzer/content :pages (unquote (get data "pages")) :total-pages (unquote (get data "total-pages")) :client-count (unquote (get data "client-count")) :server-count (unquote (get data "server-count")) :registry-sample (unquote (get data "registry-sample"))))) "data-test" (let ((data (helper "data-test-data"))) (quasiquote (~data-test/content :server-time (unquote (get data "server-time")) :items (unquote (get data "items")) :phase (unquote (get data "phase")) :transport (unquote (get data "transport"))))) "async-io" (quote (~async-io-demo/content)) "affinity" (let ((data (helper "affinity-demo-data"))) (quasiquote (~affinity-demo/content :components (unquote (get data "components")) :page-plans (unquote (get data "page-plans"))))) "optimistic" (let ((data (helper "optimistic-demo-data"))) (quasiquote (~optimistic-demo/content :items (unquote (get data "items")) :server-time (unquote (get data "server-time"))))) "offline" (let ((data (helper "offline-demo-data"))) (quasiquote (~offline-demo/content :notes (unquote (get data "notes")) :server-time (unquote (get data "server-time"))))) :else (quote (~plans/isomorphic/plan-isomorphic-content)))))) -(define provide - (fn (content) - (if (nil? content) '(~geography/provide-content) content))) +(define doc (fn (slug) (if (nil? slug) (quote (~docs-content/docs-introduction-content)) (case slug "introduction" (quote (~docs-content/docs-introduction-content)) "getting-started" (quote (~docs-content/docs-getting-started-content)) "components" (quote (~docs-content/docs-components-content)) "evaluator" (quote (~docs-content/docs-evaluator-content)) "primitives" (let ((data (helper "primitives-data"))) (quasiquote (~docs-content/docs-primitives-content :prims (~docs/primitives-tables :primitives (unquote data))))) "special-forms" (let ((data (helper "special-forms-data"))) (quasiquote (~docs-content/docs-special-forms-content :forms (~docs/special-forms-tables :forms (unquote data))))) "server-rendering" (quote (~docs-content/docs-server-rendering-content)) :else (quote (~docs-content/docs-introduction-content)))))) -(define scopes - (fn (content) - (if (nil? content) '(~geography/scopes-content) content))) +(define spec (fn (slug) (if (nil? slug) (quote (~specs/architecture-content)) (case slug "core" (let ((files (make-spec-files core-spec-items))) (quasiquote (~specs/overview-content :spec-title "Core Language" :spec-files (unquote files)))) "adapters" (let ((files (make-spec-files adapter-spec-items))) (quasiquote (~specs/overview-content :spec-title "Adapters" :spec-files (unquote files)))) "browser" (let ((files (make-spec-files browser-spec-items))) (quasiquote (~specs/overview-content :spec-title "Browser Runtime" :spec-files (unquote files)))) "reactive" (let ((files (make-spec-files reactive-spec-items))) (quasiquote (~specs/overview-content :spec-title "Reactive System" :spec-files (unquote files)))) "host" (let ((files (make-spec-files host-spec-items))) (quasiquote (~specs/overview-content :spec-title "Host Interface" :spec-files (unquote files)))) "extensions" (let ((files (make-spec-files extension-spec-items))) (quasiquote (~specs/overview-content :spec-title "Extensions" :spec-files (unquote files)))) :else (let ((found-spec (find-spec slug))) (if found-spec (let ((src (helper "read-spec-file" (get found-spec "filename")))) (quasiquote (~specs/detail-content :spec-title (unquote (get found-spec "title")) :spec-desc (unquote (get found-spec "desc")) :spec-filename (unquote (get found-spec "filename")) :spec-source (unquote src) :spec-prose (unquote (get found-spec "prose"))))) (quasiquote (~specs/not-found :slug (unquote slug))))))))) -(define spreads - (fn (content) - (if (nil? content) '(~geography/spreads-content) content))) +(define explore (fn (slug) (if (nil? slug) (quote (~specs/architecture-content)) (let ((found-spec (find-spec slug))) (if found-spec (let ((data (spec-explore (get found-spec "filename") (get found-spec "title") (get found-spec "desc")))) (if data (quasiquote (~specs-explorer/spec-explorer-content :data (unquote data))) (quasiquote (~specs/not-found :slug (unquote slug))))) (quasiquote (~specs/not-found :slug (unquote slug)))))))) -(define marshes - (fn (slug) - (if (nil? slug) - '(~reactive-islands/marshes/reactive-islands-marshes-content) - (case slug - "hypermedia-feeds" '(~reactive-islands/marshes/example-hypermedia-feeds) - "server-signals" '(~reactive-islands/marshes/example-server-signals) - "on-settle" '(~reactive-islands/marshes/example-on-settle) - "signal-triggers" '(~reactive-islands/marshes/example-signal-triggers) - "view-transform" '(~reactive-islands/marshes/example-view-transform) - :else '(~reactive-islands/marshes/reactive-islands-marshes-content))))) +(define make-spec-files (fn (items) (map (fn (item) (dict :title (get item "title") :desc (get item "desc") :prose (get item "prose") :filename (get item "filename") :href (str "/sx/(language.(spec." (get item "slug") "))") :source (helper "read-spec-file" (get item "filename")))) items))) -(define isomorphism - (fn (slug) - (if (nil? slug) - '(~plans/isomorphic/plan-isomorphic-content) - (case slug - "bundle-analyzer" - (let ((data (helper "bundle-analyzer-data"))) - `(~analyzer/bundle-analyzer-content - :pages ,(get data "pages") - :total-components ,(get data "total-components") - :total-macros ,(get data "total-macros") - :pure-count ,(get data "pure-count") - :io-count ,(get data "io-count"))) - "routing-analyzer" - (let ((data (helper "routing-analyzer-data"))) - `(~routing-analyzer/content - :pages ,(get data "pages") - :total-pages ,(get data "total-pages") - :client-count ,(get data "client-count") - :server-count ,(get data "server-count") - :registry-sample ,(get data "registry-sample"))) - "data-test" - (let ((data (helper "data-test-data"))) - `(~data-test/content - :server-time ,(get data "server-time") - :items ,(get data "items") - :phase ,(get data "phase") - :transport ,(get data "transport"))) - "async-io" '(~async-io-demo/content) - "affinity" - (let ((data (helper "affinity-demo-data"))) - `(~affinity-demo/content - :components ,(get data "components") - :page-plans ,(get data "page-plans"))) - "optimistic" - (let ((data (helper "optimistic-demo-data"))) - `(~optimistic-demo/content - :items ,(get data "items") - :server-time ,(get data "server-time"))) - "offline" - (let ((data (helper "offline-demo-data"))) - `(~offline-demo/content - :notes ,(get data "notes") - :server-time ,(get data "server-time"))) - ;; "streaming" → handled as special case by Python router - :else '(~plans/isomorphic/plan-isomorphic-content))))) +(define bootstrapper (fn (slug) (if (nil? slug) (quote (~specs/bootstrappers-index-content)) (let ((data (helper "bootstrapper-data" slug))) (if (get data "bootstrapper-not-found") (quasiquote (~specs/not-found :slug (unquote slug))) (case slug "self-hosting" (quasiquote (~specs/bootstrapper-self-hosting-content :py-sx-source (unquote (get data "py-sx-source")) :g0-output (unquote (get data "g0-output")) :g1-output (unquote (get data "g1-output")) :defines-matched (unquote (get data "defines-matched")) :defines-total (unquote (get data "defines-total")) :g0-lines (unquote (get data "g0-lines")) :g0-bytes (unquote (get data "g0-bytes")) :verification-status (unquote (get data "verification-status")))) "self-hosting-js" (quasiquote (~specs/bootstrapper-self-hosting-js-content :js-sx-source (unquote (get data "js-sx-source")) :defines-matched (unquote (get data "defines-matched")) :defines-total (unquote (get data "defines-total")) :js-sx-lines (unquote (get data "js-sx-lines")) :verification-status (unquote (get data "verification-status")))) "python" (quasiquote (~specs/bootstrapper-py-content :bootstrapper-source (unquote (get data "bootstrapper-source")) :bootstrapped-output (unquote (get data "bootstrapped-output")))) "page-helpers" (let ((ph-data (helper "page-helpers-demo-data"))) (quasiquote (~page-helpers-demo/content :sf-categories (unquote (get ph-data "sf-categories")) :sf-total (unquote (get ph-data "sf-total")) :sf-ms (unquote (get ph-data "sf-ms")) :ref-sample (unquote (get ph-data "ref-sample")) :ref-ms (unquote (get ph-data "ref-ms")) :attr-result (unquote (get ph-data "attr-result")) :attr-ms (unquote (get ph-data "attr-ms")) :comp-source (unquote (get ph-data "comp-source")) :comp-ms (unquote (get ph-data "comp-ms")) :routing-result (unquote (get ph-data "routing-result")) :routing-ms (unquote (get ph-data "routing-ms")) :server-total-ms (unquote (get ph-data "server-total-ms")) :sf-source (unquote (get ph-data "sf-source")) :attr-detail (unquote (get ph-data "attr-detail")) :req-attrs (unquote (get ph-data "req-attrs")) :attr-keys (unquote (get ph-data "attr-keys"))))) :else (quasiquote (~specs/bootstrapper-js-content :bootstrapper-source (unquote (get data "bootstrapper-source")) :bootstrapped-output (unquote (get data "bootstrapped-output")))))))))) -;; --------------------------------------------------------------------------- -;; Page functions — leaf dispatch to content components -;; --------------------------------------------------------------------------- +(define test (fn (slug) (if (nil? slug) (let ((data (helper "run-modular-tests" "all"))) (quasiquote (~testing/overview-content :server-results (unquote (get data "server-results")) :framework-source (unquote (get data "framework-source")) :eval-source (unquote (get data "eval-source")) :parser-source (unquote (get data "parser-source")) :router-source (unquote (get data "router-source")) :render-source (unquote (get data "render-source")) :deps-source (unquote (get data "deps-source")) :engine-source (unquote (get data "engine-source"))))) (case slug "runners" (quote (~testing/runners-content)) :else (let ((data (helper "run-modular-tests" slug))) (case slug "eval" (quasiquote (~testing/spec-content :spec-name "eval" :spec-title "Evaluator Tests" :spec-desc "81 tests covering the core evaluator and all primitives." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) "parser" (quasiquote (~testing/spec-content :spec-name "parser" :spec-title "Parser Tests" :spec-desc "39 tests covering tokenization and parsing." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) "router" (quasiquote (~testing/spec-content :spec-name "router" :spec-title "Router Tests" :spec-desc "18 tests covering client-side route matching." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) "render" (quasiquote (~testing/spec-content :spec-name "render" :spec-title "Renderer Tests" :spec-desc "23 tests covering HTML rendering." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) "deps" (quasiquote (~testing/spec-content :spec-name "deps" :spec-title "Dependency Analysis Tests" :spec-desc "33 tests covering component dependency analysis." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) "engine" (quasiquote (~testing/spec-content :spec-name "engine" :spec-title "Engine Tests" :spec-desc "37 tests covering engine pure functions." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) "orchestration" (quasiquote (~testing/spec-content :spec-name "orchestration" :spec-title "Orchestration Tests" :spec-desc "17 tests covering orchestration." :spec-source (unquote (get data "spec-source")) :framework-source (unquote (get data "framework-source")) :server-results (unquote (get data "server-results")))) :else (quasiquote (~testing/overview-content :server-results (unquote (get data "server-results")))))))))) -;; Docs (under language) -(define doc - (fn (slug) - (if (nil? slug) - '(~docs-content/docs-introduction-content) - (case slug - "introduction" '(~docs-content/docs-introduction-content) - "getting-started" '(~docs-content/docs-getting-started-content) - "components" '(~docs-content/docs-components-content) - "evaluator" '(~docs-content/docs-evaluator-content) - "primitives" - (let ((data (helper "primitives-data"))) - `(~docs-content/docs-primitives-content - :prims (~docs/primitives-tables :primitives ,data))) - "special-forms" - (let ((data (helper "special-forms-data"))) - `(~docs-content/docs-special-forms-content - :forms (~docs/special-forms-tables :forms ,data))) - "server-rendering" '(~docs-content/docs-server-rendering-content) - :else '(~docs-content/docs-introduction-content))))) +(define reference (fn (slug) (if (nil? slug) (quote (~examples/reference-index-content)) (let ((data (helper "reference-data" slug))) (case slug "attributes" (quasiquote (~reference/attrs-content :req-table (~docs/attr-table-from-data :title "Request Attributes" :attrs (unquote (get data "req-attrs"))) :beh-table (~docs/attr-table-from-data :title "Behavior Attributes" :attrs (unquote (get data "beh-attrs"))) :uniq-table (~docs/attr-table-from-data :title "Unique to sx" :attrs (unquote (get data "uniq-attrs"))))) "headers" (quasiquote (~reference/headers-content :req-table (~docs/headers-table-from-data :title "Request Headers" :headers (unquote (get data "req-headers"))) :resp-table (~docs/headers-table-from-data :title "Response Headers" :headers (unquote (get data "resp-headers"))))) "events" (quasiquote (~reference/events-content :table (~docs/two-col-table-from-data :intro "sx fires custom DOM events at various points in the request lifecycle." :col1 "Event" :col2 "Description" :items (unquote (get data "events-list"))))) "js-api" (quasiquote (~reference/js-api-content :table (~docs/two-col-table-from-data :intro "The client-side sx.js library exposes a public API for programmatic use." :col1 "Method" :col2 "Description" :items (unquote (get data "js-api-list"))))) :else (quasiquote (~reference/attrs-content :req-table (~docs/attr-table-from-data :title "Request Attributes" :attrs (unquote (get data "req-attrs"))) :beh-table (~docs/attr-table-from-data :title "Behavior Attributes" :attrs (unquote (get data "beh-attrs"))) :uniq-table (~docs/attr-table-from-data :title "Unique to sx" :attrs (unquote (get data "uniq-attrs")))))))))) -;; Specs (under language) -(define spec - (fn (slug) - (if (nil? slug) - '(~specs/architecture-content) - (case slug - "core" - (let ((files (make-spec-files core-spec-items))) - `(~specs/overview-content :spec-title "Core Language" :spec-files ,files)) - "adapters" - (let ((files (make-spec-files adapter-spec-items))) - `(~specs/overview-content :spec-title "Adapters" :spec-files ,files)) - "browser" - (let ((files (make-spec-files browser-spec-items))) - `(~specs/overview-content :spec-title "Browser Runtime" :spec-files ,files)) - "reactive" - (let ((files (make-spec-files reactive-spec-items))) - `(~specs/overview-content :spec-title "Reactive System" :spec-files ,files)) - "host" - (let ((files (make-spec-files host-spec-items))) - `(~specs/overview-content :spec-title "Host Interface" :spec-files ,files)) - "extensions" - (let ((files (make-spec-files extension-spec-items))) - `(~specs/overview-content :spec-title "Extensions" :spec-files ,files)) - :else (let ((found-spec (find-spec slug))) - (if found-spec - (let ((src (helper "read-spec-file" (get found-spec "filename")))) - `(~specs/detail-content - :spec-title ,(get found-spec "title") - :spec-desc ,(get found-spec "desc") - :spec-filename ,(get found-spec "filename") - :spec-source ,src - :spec-prose ,(get found-spec "prose"))) - `(~specs/not-found :slug ,slug))))))) +(define reference-detail (fn (kind slug) (if (nil? slug) nil (case kind "attributes" (let ((data (helper "attr-detail-data" slug))) (if (get data "attr-not-found") (quasiquote (~reference/attr-not-found :slug (unquote slug))) (quasiquote (~reference/attr-detail-content :title (unquote (get data "attr-title")) :description (unquote (get data "attr-description")) :demo (unquote (get data "attr-demo")) :example-code (unquote (get data "attr-example")) :handler-code (unquote (get data "attr-handler")) :wire-placeholder-id (unquote (get data "attr-wire-id")))))) "headers" (let ((data (helper "header-detail-data" slug))) (if (get data "header-not-found") (quasiquote (~reference/attr-not-found :slug (unquote slug))) (quasiquote (~reference/header-detail-content :title (unquote (get data "header-title")) :direction (unquote (get data "header-direction")) :description (unquote (get data "header-description")) :example-code (unquote (get data "header-example")) :demo (unquote (get data "header-demo")))))) "events" (let ((data (helper "event-detail-data" slug))) (if (get data "event-not-found") (quasiquote (~reference/attr-not-found :slug (unquote slug))) (quasiquote (~reference/event-detail-content :title (unquote (get data "event-title")) :description (unquote (get data "event-description")) :example-code (unquote (get data "event-example")) :demo (unquote (get data "event-demo")))))) :else nil)))) -;; Spec explorer (under language → spec) -;; Uses spec-explore from spec-introspect.sx — the spec examines itself. -(define explore - (fn (slug) - (if (nil? slug) - '(~specs/architecture-content) - (let ((found-spec (find-spec slug))) - (if found-spec - (let ((data (spec-explore - (get found-spec "filename") - (get found-spec "title") - (get found-spec "desc")))) - (if data - `(~specs-explorer/spec-explorer-content :data ,data) - `(~specs/not-found :slug ,slug))) - `(~specs/not-found :slug ,slug)))))) +(define example (fn (slug) (if (nil? slug) nil (list (slug->component slug "~examples-content/example-" nil ""))))) -;; Helper used by spec — make-spec-files -(define make-spec-files - (fn (items) - (map (fn (item) - (dict :title (get item "title") :desc (get item "desc") - :prose (get item "prose") - :filename (get item "filename") :href (str "/sx/(language.(spec." (get item "slug") "))") - :source (helper "read-spec-file" (get item "filename")))) - items))) +(define sx-urls (fn (slug) (quote (~sx-urls/urls-content)))) -;; Bootstrappers (under language) -(define bootstrapper - (fn (slug) - (if (nil? slug) - '(~specs/bootstrappers-index-content) - (let ((data (helper "bootstrapper-data" slug))) - (if (get data "bootstrapper-not-found") - `(~specs/not-found :slug ,slug) - (case slug - "self-hosting" - `(~specs/bootstrapper-self-hosting-content - :py-sx-source ,(get data "py-sx-source") - :g0-output ,(get data "g0-output") - :g1-output ,(get data "g1-output") - :defines-matched ,(get data "defines-matched") - :defines-total ,(get data "defines-total") - :g0-lines ,(get data "g0-lines") - :g0-bytes ,(get data "g0-bytes") - :verification-status ,(get data "verification-status")) - "self-hosting-js" - `(~specs/bootstrapper-self-hosting-js-content - :js-sx-source ,(get data "js-sx-source") - :defines-matched ,(get data "defines-matched") - :defines-total ,(get data "defines-total") - :js-sx-lines ,(get data "js-sx-lines") - :verification-status ,(get data "verification-status")) - "python" - `(~specs/bootstrapper-py-content - :bootstrapper-source ,(get data "bootstrapper-source") - :bootstrapped-output ,(get data "bootstrapped-output")) - "page-helpers" - (let ((ph-data (helper "page-helpers-demo-data"))) - `(~page-helpers-demo/content - :sf-categories ,(get ph-data "sf-categories") - :sf-total ,(get ph-data "sf-total") - :sf-ms ,(get ph-data "sf-ms") - :ref-sample ,(get ph-data "ref-sample") - :ref-ms ,(get ph-data "ref-ms") - :attr-result ,(get ph-data "attr-result") - :attr-ms ,(get ph-data "attr-ms") - :comp-source ,(get ph-data "comp-source") - :comp-ms ,(get ph-data "comp-ms") - :routing-result ,(get ph-data "routing-result") - :routing-ms ,(get ph-data "routing-ms") - :server-total-ms ,(get ph-data "server-total-ms") - :sf-source ,(get ph-data "sf-source") - :attr-detail ,(get ph-data "attr-detail") - :req-attrs ,(get ph-data "req-attrs") - :attr-keys ,(get ph-data "attr-keys"))) - :else - `(~specs/bootstrapper-js-content - :bootstrapper-source ,(get data "bootstrapper-source") - :bootstrapped-output ,(get data "bootstrapped-output")))))))) +(define cssx (make-page-fn "~cssx/overview-content" "~cssx/" nil "-content")) -;; Testing (under language) -(define test - (fn (slug) - (if (nil? slug) - (let ((data (helper "run-modular-tests""all"))) - `(~testing/overview-content - :server-results ,(get data "server-results") - :framework-source ,(get data "framework-source") - :eval-source ,(get data "eval-source") - :parser-source ,(get data "parser-source") - :router-source ,(get data "router-source") - :render-source ,(get data "render-source") - :deps-source ,(get data "deps-source") - :engine-source ,(get data "engine-source"))) - (case slug - "runners" '(~testing/runners-content) - :else - (let ((data (helper "run-modular-tests"slug))) - (case slug - "eval" `(~testing/spec-content - :spec-name "eval" :spec-title "Evaluator Tests" - :spec-desc "81 tests covering the core evaluator and all primitives." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - "parser" `(~testing/spec-content - :spec-name "parser" :spec-title "Parser Tests" - :spec-desc "39 tests covering tokenization and parsing." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - "router" `(~testing/spec-content - :spec-name "router" :spec-title "Router Tests" - :spec-desc "18 tests covering client-side route matching." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - "render" `(~testing/spec-content - :spec-name "render" :spec-title "Renderer Tests" - :spec-desc "23 tests covering HTML rendering." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - "deps" `(~testing/spec-content - :spec-name "deps" :spec-title "Dependency Analysis Tests" - :spec-desc "33 tests covering component dependency analysis." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - "engine" `(~testing/spec-content - :spec-name "engine" :spec-title "Engine Tests" - :spec-desc "37 tests covering engine pure functions." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - "orchestration" `(~testing/spec-content - :spec-name "orchestration" :spec-title "Orchestration Tests" - :spec-desc "17 tests covering orchestration." - :spec-source ,(get data "spec-source") - :framework-source ,(get data "framework-source") - :server-results ,(get data "server-results")) - :else `(~testing/overview-content - :server-results ,(get data "server-results")))))))) +(define protocol (make-page-fn "~protocols/wire-format-content" "~protocols/" nil "-content")) -;; Reference (under geography → hypermedia) -(define reference - (fn (slug) - (if (nil? slug) - '(~examples/reference-index-content) - (let ((data (helper "reference-data" slug))) - (case slug - "attributes" `(~reference/attrs-content - :req-table (~docs/attr-table-from-data :title "Request Attributes" :attrs ,(get data "req-attrs")) - :beh-table (~docs/attr-table-from-data :title "Behavior Attributes" :attrs ,(get data "beh-attrs")) - :uniq-table (~docs/attr-table-from-data :title "Unique to sx" :attrs ,(get data "uniq-attrs"))) - "headers" `(~reference/headers-content - :req-table (~docs/headers-table-from-data :title "Request Headers" :headers ,(get data "req-headers")) - :resp-table (~docs/headers-table-from-data :title "Response Headers" :headers ,(get data "resp-headers"))) - "events" `(~reference/events-content - :table (~docs/two-col-table-from-data - :intro "sx fires custom DOM events at various points in the request lifecycle." - :col1 "Event" :col2 "Description" :items ,(get data "events-list"))) - "js-api" `(~reference/js-api-content - :table (~docs/two-col-table-from-data - :intro "The client-side sx.js library exposes a public API for programmatic use." - :col1 "Method" :col2 "Description" :items ,(get data "js-api-list"))) - :else `(~reference/attrs-content - :req-table (~docs/attr-table-from-data :title "Request Attributes" :attrs ,(get data "req-attrs")) - :beh-table (~docs/attr-table-from-data :title "Behavior Attributes" :attrs ,(get data "beh-attrs")) - :uniq-table (~docs/attr-table-from-data :title "Unique to sx" :attrs ,(get data "uniq-attrs")))))))) +(define sx-pub (fn (slug) (if (nil? slug) (quote (~sx-pub/overview-content)) nil))) -;; Reference detail pages (under geography → hypermedia → reference) -;; Takes two positional args: kind and slug -(define reference-detail - (fn (kind slug) - (if (nil? slug) nil - (case kind - "attributes" - (let ((data (helper "attr-detail-data" slug))) - (if (get data "attr-not-found") - `(~reference/attr-not-found :slug ,slug) - `(~reference/attr-detail-content - :title ,(get data "attr-title") - :description ,(get data "attr-description") - :demo ,(get data "attr-demo") - :example-code ,(get data "attr-example") - :handler-code ,(get data "attr-handler") - :wire-placeholder-id ,(get data "attr-wire-id")))) - "headers" - (let ((data (helper "header-detail-data" slug))) - (if (get data "header-not-found") - `(~reference/attr-not-found :slug ,slug) - `(~reference/header-detail-content - :title ,(get data "header-title") - :direction ,(get data "header-direction") - :description ,(get data "header-description") - :example-code ,(get data "header-example") - :demo ,(get data "header-demo")))) - "events" - (let ((data (helper "event-detail-data" slug))) - (if (get data "event-not-found") - `(~reference/attr-not-found :slug ,slug) - `(~reference/event-detail-content - :title ,(get data "event-title") - :description ,(get data "event-description") - :example-code ,(get data "event-example") - :demo ,(get data "event-demo")))) - :else nil)))) +(define sx-tools (fn (&key title &rest args) (quasiquote (~sx-tools/overview-content :title (unquote (or title "SX Tools")) (splice-unquote args))))) -;; Examples (under geography → hypermedia) -;; Convention: ~examples-content/example-{slug} -(define example - (fn (slug) - (if (nil? slug) nil - (list (slug->component slug "~examples-content/example-" nil ""))))) +(define reactive-runtime (make-page-fn "~reactive-runtime/overview-content" "~reactive-runtime/" nil "-content")) -;; SX URLs (under applications) -(define sx-urls - (fn (slug) - '(~sx-urls/urls-content))) +(define essay (make-page-fn "~essays/index/essays-index-content" "~essays/" "/essay-" "")) -;; CSSX (under applications) -;; Convention: ~cssx/{slug}-content -(define cssx - (make-page-fn "~cssx/overview-content" "~cssx/" nil "-content")) +(define philosophy (fn (slug) (if (nil? slug) (quote (~essays/philosophy-index/content)) (case slug "sx-manifesto" (quote (~essay-sx-manifesto)) "godel-escher-bach" (quote (~essays/godel-escher-bach/essay-godel-escher-bach)) "wittgenstein" (quote (~essays/sx-and-wittgenstein/essay-sx-and-wittgenstein)) "dennett" (quote (~essays/sx-and-dennett/essay-sx-and-dennett)) "existentialism" (quote (~essays/s-existentialism/essay-s-existentialism)) "platonic-sx" (quote (~essays/platonic-sx/essay-platonic-sx)) :else (quote (~essays/philosophy-index/content)))))) -;; Protocols (under applications) -;; Convention: ~protocols/{slug}-content -(define protocol - (make-page-fn "~protocols/wire-format-content" "~protocols/" nil "-content")) - -;; sx-pub (under applications) -(define sx-pub - (fn (slug) - (if (nil? slug) - '(~sx-pub/overview-content) - nil))) - -;; SX Tools (under applications) -(define sx-tools - (fn (slug) - '(~sx-tools/overview-content))) - -;; Reactive Runtime (under applications) -;; Convention: ~reactive-runtime/{slug}-content -(define reactive-runtime - (make-page-fn "~reactive-runtime/overview-content" "~reactive-runtime/" nil "-content")) - -;; Essays (under etc) -;; Convention: ~essays/{slug}/essay-{slug} -(define essay - (make-page-fn "~essays/index/essays-index-content" "~essays/" "/essay-" "")) - -;; Philosophy (under etc) -(define philosophy - (fn (slug) - (if (nil? slug) - '(~essays/philosophy-index/content) - (case slug - "sx-manifesto" '(~essay-sx-manifesto) - "godel-escher-bach" '(~essays/godel-escher-bach/essay-godel-escher-bach) - "wittgenstein" '(~essays/sx-and-wittgenstein/essay-sx-and-wittgenstein) - "dennett" '(~essays/sx-and-dennett/essay-sx-and-dennett) - "existentialism" '(~essays/s-existentialism/essay-s-existentialism) - "platonic-sx" '(~essays/platonic-sx/essay-platonic-sx) - :else '(~essays/philosophy-index/content))))) - -;; Plans (under etc) -;; Convention: ~plans/{slug}/plan-{slug}-content -(define plan - (make-page-fn "~plans/index/plans-index-content" "~plans/" "/plan-" "-content")) +(define plan (make-page-fn "~plans/index/plans-index-content" "~plans/" "/plan-" "-content")) diff --git a/sx/sx/sx-tools-editor.sx b/sx/sx/sx-tools-editor.sx index 76728962..9866ec8e 100644 --- a/sx/sx/sx-tools-editor.sx +++ b/sx/sx/sx-tools-editor.sx @@ -1 +1 @@ -(defisland ~sx-tools/tree-editor () (let ((source (signal "(defcomp ~card (&key title subtitle)\n (div :class \"card\"\n (h2 title)\n (when subtitle\n (p :class \"sub\" subtitle))))")) (view-mode (signal "tree")) (selected-path (signal nil)) (parsed (signal nil))) (letrec ((fmt-path (fn (path) (str "[" (join "," (map str path)) "]"))) (node-disp (fn (node) (cond (nil? node) "nil" (= (type-of node) "symbol") (symbol-name node) (= (type-of node) "keyword") (str ":" (keyword-name node)) (string? node) (let ((s (if (> (len node) 35) (str (slice node 0 32) "...") node))) (str "\"" s "\"")) (number? node) (str node) (= (type-of node) "boolean") (if node "true" "false") (list? node) (if (empty? node) "()" (str "(" (node-disp (first node)) (if (> (len node) 1) " ..." "") ")")) :else (str node)))) (is-compact (fn (node) (and (list? node) (<= (len node) 4) (not (some (fn (c) (list? c)) (rest node)))))) (build-entries (fn (node path depth result) (if (list? node) (if (empty? node) (append! result {:expandable false :depth depth :text "()" :is-list false :path path}) (if (is-compact node) (append! result {:expandable false :depth depth :text (str "(" (join " " (map node-disp node)) ")") :is-list true :path path}) (do (append! result {:expandable true :depth depth :text (str "(" (node-disp (first node))) :is-list true :path path}) (for-each (fn (i) (build-entries (nth node i) (concat path (list i)) (+ depth 1) result)) (range 1 (len node)))))) (append! result {:expandable false :depth depth :text (node-disp node) :is-list false :path path})))) (nav (fn (tree path) (reduce (fn (current idx) (if (or (nil? current) (not (list? current)) (>= idx (len current))) nil (nth current idx))) tree path))) (build-context (fn (tree path) (let ((result (list))) (for-each (fn (depth) (let ((prefix (slice path 0 (+ depth 1))) (node (nav tree prefix))) (when (not (nil? node)) (let ((is-target (= (+ depth 1) (len path)))) (append! result {:depth depth :is-target is-target :text (if (list? node) (if (empty? node) "()" (let ((head (node-disp (first node)))) (if (> (len node) 3) (str "(" head " " (node-disp (nth node 1)) " ...)") (str "(" (join " " (map node-disp node)) ")")))) (node-disp node)) :path prefix}))))) (range 0 (len path))) result))) (do-validate (fn (tree) (let ((errors (list))) (letrec ((check (fn (node path) (when (list? node) (when (not (empty? node)) (let ((head (first node))) (when (and (= (type-of head) "symbol") (or (= (symbol-name head) "letrec")) (>= (len node) 2)) (let ((bindings (nth node 1))) (when (list? bindings) (for-each (fn (i) (let ((pair (nth bindings i))) (when (not (and (list? pair) (>= (len pair) 2) (= (type-of (first pair)) "symbol"))) (append! errors (str "Binding " i " at " (fmt-path (concat path (list 1 i))) " is not a (name value) pair"))))) (range 0 (len bindings)))))) (when (and (= (type-of head) "symbol") (or (= (symbol-name head) "defcomp") (= (symbol-name head) "defisland"))) (when (< (len node) 4) (append! errors (str (symbol-name head) " at " (fmt-path path) " missing body")))))) (for-each (fn (i) (check (nth node i) (concat path (list i)))) (range 0 (len node))))))) (for-each (fn (i) (check (nth tree i) (list i))) (range 0 (len tree)))) (if (empty? errors) "OK" (join "\n" errors)))))) (reset! parsed (sx-parse (deref source))) (div :class "space-y-4" (div :class "space-y-2" (label :class "text-sm font-medium text-stone-700" "SX Source") (textarea :class "w-full font-mono text-xs bg-stone-50 border border-stone-200 rounded p-3 leading-relaxed" :rows 6 :bind source)) (div :class "flex gap-2 items-center" (button :class "px-3 py-1 text-xs rounded bg-stone-700 text-white hover:bg-stone-800" :on-click (fn (e) (reset! parsed (sx-parse (deref source))) (reset! selected-path nil)) "Parse") (for-each (fn (mode) (button :class (str "px-3 py-1 text-xs rounded border transition-colors " (if (= (deref view-mode) mode) "bg-violet-600 text-white border-violet-600" "bg-white text-stone-600 border-stone-200 hover:border-violet-300")) :on-click (fn (e) (reset! view-mode mode)) mode)) (list "tree" "context" "validate" "render"))) (if (or (nil? (deref parsed)) (empty? (deref parsed))) (div :class "text-red-500 text-sm font-mono p-3 bg-red-50 rounded" "Parse error — check your s-expression syntax") (div :class "bg-stone-50 rounded border border-stone-200 p-3 font-mono text-xs leading-relaxed overflow-x-auto" (when (= (deref view-mode) "tree") (let ((entries (list)) (tree (deref parsed))) (for-each (fn (i) (build-entries (nth tree i) (list i) 0 entries)) (range 0 (len tree))) (div :class "space-y-0" (map (fn (entry) (let ((path (get entry "path")) (sel (deref selected-path)) (is-selected (and (not (nil? sel)) (= (fmt-path sel) (fmt-path path))))) (div :class (str "py-0.5 cursor-pointer hover:bg-violet-50 rounded px-1 " (if is-selected "bg-violet-100" "")) :style (str "padding-left:" (* (get entry "depth") 16) "px") :on-click (fn (e) (reset! selected-path path)) (span :class "text-stone-400 mr-2 select-none" (fmt-path path)) (span :class (if (get entry "is-list") "text-sky-700" "text-stone-600") (get entry "text"))))) entries)))) (when (= (deref view-mode) "context") (if (nil? (deref selected-path)) (p :class "text-stone-400 italic" "Click a node in tree view to see its context") (let ((ctx (build-context (deref parsed) (deref selected-path)))) (div :class "space-y-1" (map (fn (item) (div :style (str "padding-left:" (* (get item "depth") 16) "px") :class (if (get item "is-target") "text-violet-700 font-semibold" "text-stone-600") (span :class "text-stone-400 mr-2" (if (get item "is-target") "→ " " ") (fmt-path (get item "path"))) (span (get item "text")))) ctx))))) (when (= (deref view-mode) "validate") (let ((result (do-validate (deref parsed)))) (div :class (if (= result "OK") "text-emerald-600" "text-amber-600 whitespace-pre-wrap") result))) (when (= (deref view-mode) "render") (let ((tree (deref parsed))) (div :class "prose prose-sm max-w-none" (map (fn (expr) (if (and (list? expr) (not (empty? expr)) (= (type-of (first expr)) "symbol") (is-html-tag? (symbol-name (first expr)))) expr (div :class "font-mono text-xs text-stone-400 p-2 bg-stone-100 rounded" (sx-serialize expr)))) tree)))))))))) +(defisland ~sx-tools/tree-editor () (let ((source (signal "(defcomp ~card (&key title subtitle)\n (div :class \"card\"\n (h2 title)\n (when subtitle\n (p :class \"sub\" subtitle))))")) (view-mode (signal "tree")) (selected-path (signal nil)) (parsed (signal nil)) (bindings (signal (dict)))) (letrec ((fmt-path (fn (path) (str "[" (join "," (map str path)) "]"))) (node-disp (fn (node) (cond (nil? node) "nil" (= (type-of node) "symbol") (symbol-name node) (= (type-of node) "keyword") (str ":" (keyword-name node)) (string? node) (let ((s (if (> (len node) 35) (str (slice node 0 32) "...") node))) (str "\"" s "\"")) (number? node) (str node) (= (type-of node) "boolean") (if node "true" "false") (list? node) (if (empty? node) "()" (str "(" (node-disp (first node)) (if (> (len node) 1) " ..." "") ")")) :else (str node)))) (is-compact (fn (node) (and (list? node) (<= (len node) 4) (not (some (fn (c) (list? c)) (rest node)))))) (build-entries (fn (node path depth result) (if (list? node) (if (empty? node) (append! result {:expandable false :depth depth :text "()" :is-list false :path path}) (if (is-compact node) (append! result {:expandable false :depth depth :text (str "(" (join " " (map node-disp node)) ")") :is-list true :path path}) (do (append! result {:expandable true :depth depth :text (str "(" (node-disp (first node))) :is-list true :path path}) (for-each (fn (i) (build-entries (nth node i) (concat path (list i)) (+ depth 1) result)) (range 1 (len node)))))) (append! result {:expandable false :depth depth :text (node-disp node) :is-list false :path path})))) (nav (fn (tree path) (reduce (fn (current idx) (if (or (nil? current) (not (list? current)) (>= idx (len current))) nil (nth current idx))) tree path))) (build-context (fn (tree path) (let ((result (list))) (for-each (fn (depth) (let ((prefix (slice path 0 (+ depth 1))) (node (nav tree prefix))) (when (not (nil? node)) (let ((is-target (= (+ depth 1) (len path)))) (append! result {:depth depth :is-target is-target :text (if (list? node) (if (empty? node) "()" (let ((head (node-disp (first node)))) (if (> (len node) 3) (str "(" head " " (node-disp (nth node 1)) " ...)") (str "(" (join " " (map node-disp node)) ")")))) (node-disp node)) :path prefix}))))) (range 0 (len path))) result))) (do-validate (fn (tree) (let ((errors (list))) (letrec ((check (fn (node path) (when (list? node) (when (not (empty? node)) (let ((head (first node))) (when (and (= (type-of head) "symbol") (or (= (symbol-name head) "letrec")) (>= (len node) 2)) (let ((bindings (nth node 1))) (when (list? bindings) (for-each (fn (i) (let ((pair (nth bindings i))) (when (not (and (list? pair) (>= (len pair) 2) (= (type-of (first pair)) "symbol"))) (append! errors (str "Binding " i " at " (fmt-path (concat path (list 1 i))) " is not a (name value) pair"))))) (range 0 (len bindings)))))) (when (and (= (type-of head) "symbol") (or (= (symbol-name head) "defcomp") (= (symbol-name head) "defisland"))) (when (< (len node) 4) (append! errors (str (symbol-name head) " at " (fmt-path path) " missing body")))))) (for-each (fn (i) (check (nth node i) (concat path (list i)))) (range 0 (len node))))))) (for-each (fn (i) (check (nth tree i) (list i))) (range 0 (len tree)))) (if (empty? errors) "OK" (join "\n" errors))))) (extract-params (fn (expr) (let ((head (if (and (list? expr) (not (empty? expr)) (= (type-of (first expr)) "symbol")) (symbol-name (first expr)) nil)) (params-list (if (and (list? expr) (> (len expr) 2)) (nth expr 2) nil))) (if (and (or (= head "defcomp") (= head "defisland")) (list? params-list)) (let ((result (list)) (in-key false)) (for-each (fn (p) (cond (and (= (type-of p) "symbol") (= (symbol-name p) "&key")) (set! in-key true) (and (= (type-of p) "symbol") (= (symbol-name p) "&rest")) (set! in-key false) in-key (cond (and (list? p) (not (empty? p))) (append! result (if (= (type-of (first p)) "symbol") (symbol-name (first p)) (str (first p)))) (= (type-of p) "symbol") (append! result (symbol-name p)) :else nil))) params-list) result) (list)))))) (reset! parsed (sx-parse (deref source))) (div :class "space-y-4" (div :class "space-y-2" (label :class "text-sm font-medium text-stone-700" "SX Source") (textarea :class "w-full font-mono text-xs bg-stone-50 border border-stone-200 rounded p-3 leading-relaxed" :rows 6 :bind source)) (div :class "flex gap-2 items-center" (button :class "px-3 py-1 text-xs rounded bg-stone-700 text-white hover:bg-stone-800" :on-click (fn (e) (reset! parsed (sx-parse (deref source))) (reset! selected-path nil)) "Parse") (for-each (fn (mode) (button :class (str "px-3 py-1 text-xs rounded border transition-colors " (if (= (deref view-mode) mode) "bg-violet-600 text-white border-violet-600" "bg-white text-stone-600 border-stone-200 hover:border-violet-300")) :on-click (fn (e) (reset! view-mode mode)) mode)) (list "tree" "context" "validate" "render"))) (when (= (deref view-mode) "render") (let ((tree (deref parsed)) (all-params (let ((acc (list))) (when (and tree (not (empty? tree))) (for-each (fn (expr) (for-each (fn (p) (when (not (some (fn (x) (= x p)) acc)) (append! acc p))) (extract-params expr))) tree)) acc))) (when (not (empty? all-params)) (div :class "space-y-2 p-3 bg-violet-50 rounded border border-violet-200" (div :class "text-xs font-semibold text-violet-700 mb-1" "Parameters") (map (fn (pname) (div :class "flex items-center gap-2" (label :class "text-xs font-mono text-stone-600 w-24 text-right" pname) (input :type "text" :class "flex-1 px-2 py-1 text-xs font-mono border border-stone-300 rounded bg-white" :placeholder (str pname " value") :on-input (fn (e) (reset! bindings (assoc (deref bindings) pname (element-value (host-get e "target")))))))) all-params))))) (if (or (nil? (deref parsed)) (empty? (deref parsed))) (div :class "text-red-500 text-sm font-mono p-3 bg-red-50 rounded" "Parse error — check your s-expression syntax") (div :class "bg-stone-50 rounded border border-stone-200 p-3 font-mono text-xs leading-relaxed overflow-x-auto" (cond (= (deref view-mode) "tree") (let ((entries (list)) (tree (deref parsed))) (for-each (fn (i) (build-entries (nth tree i) (list i) 0 entries)) (range 0 (len tree))) (div :class "space-y-0" (map (fn (entry) (let ((path (get entry "path")) (sel (deref selected-path)) (is-selected (and (not (nil? sel)) (= (fmt-path sel) (fmt-path path))))) (div :class (str "py-0.5 cursor-pointer hover:bg-violet-50 rounded px-1 " (if is-selected "bg-violet-100" "")) :style (str "padding-left:" (* (get entry "depth") 16) "px") :on-click (fn (e) (reset! selected-path path)) (span :class "text-stone-400 mr-2 select-none" (fmt-path path)) (span :class (if (get entry "is-list") "text-sky-700" "text-stone-600") (get entry "text"))))) entries))) (= (deref view-mode) "context") (if (nil? (deref selected-path)) (p :class "text-stone-400 italic" "Click a node in tree view to see its context") (let ((ctx (build-context (deref parsed) (deref selected-path)))) (div :class "space-y-1" (map (fn (item) (div :style (str "padding-left:" (* (get item "depth") 16) "px") :class (if (get item "is-target") "text-violet-700 font-semibold" "text-stone-600") (span :class "text-stone-400 mr-2" (if (get item "is-target") "→ " " ") (fmt-path (get item "path"))) (span (get item "text")))) ctx)))) (= (deref view-mode) "validate") (let ((result (do-validate (deref parsed)))) (div :class (if (= result "OK") "text-emerald-600" "text-amber-600 whitespace-pre-wrap") result)) (= (deref view-mode) "render") (let ((tree (deref parsed))) (div :class "prose prose-sm max-w-none font-sans" (map (fn (expr) (if (not (and (list? expr) (not (empty? expr)) (= (type-of (first expr)) "symbol"))) (div :class "font-mono text-xs text-stone-400 p-2 bg-stone-100 rounded" (sx-serialize expr)) (let ((head-name (symbol-name (first expr)))) (cond (is-html-tag? head-name) expr (or (= head-name "defcomp") (= head-name "defisland")) (let ((body (last expr)) (params (extract-params expr)) (b (deref bindings))) (div (div :class "text-xs text-stone-400 mb-2 font-mono" (str head-name " " (node-disp (nth expr 1)))) (letrec ((subst (fn (node) (cond (and (= (type-of node) "symbol") (some (fn (p) (= p (symbol-name node))) params)) (or (get b (symbol-name node)) "") (list? node) (map subst node) :else node)))) (subst body)))) (= head-name "let") (last expr) :else (div :class "font-mono text-xs text-stone-400 p-2 bg-stone-100 rounded" (sx-serialize expr)))))) tree))) :else (p "Select a view mode")))))))) diff --git a/sx/sx/sx-tools.sx b/sx/sx/sx-tools.sx index c7c3b8f5..e5469bd2 100644 --- a/sx/sx/sx-tools.sx +++ b/sx/sx/sx-tools.sx @@ -1,210 +1 @@ -;; SX Tools — Structural reading and editing tools for s-expression files. -;; Lives under the Applications section: /(applications.(sx-tools)) - -(defcomp ~sx-tools/overview-content () - (~docs/page :title "SX Tools" - (p :class "text-stone-500 text-sm italic mb-8" - "A structural tree editor for s-expression files — because the thing that reads and edits code should understand the code as a tree, not as a sequence of characters.") - - ;; ----------------------------------------------------------------- - (~docs/section :title "The problem" :id "problem" - (p "On 25 March 2026, the SX documentation site went blank. The home page stepper widget — a 310-line " (code "defisland") " — failed to render. The cause was a single extra closing parenthesis on line 222 of " (code "home-stepper.sx") ".") - (p "That parenthesis closed the " (code "letrec") " bindings list one level too early. Two function definitions — " (code "rebuild-preview") " and " (code "do-back") " — silently became body expressions instead of bindings. They were evaluated and discarded rather than bound in scope. Every subsequent reference to " (code "rebuild-preview") " raised " (code "Undefined symbol") ". The island rendered nothing. The page went white.") - (p "Finding this took an hour of systematic debugging: adding trace output to the OCaml " (code "env_has") " function, dumping the scope chain at the point of failure, counting keys in the letrec environment (" - (em "12 where there should have been 14") "), and finally writing a paren-depth tracer that walked the file character by character to find where the nesting diverged from expectation.") - (p "The fix was removing one character.") - (p "This is a class of bug, not an incident. S-expressions encode tree structure in linear text using matched delimiters. When those delimiters are wrong, the meaning of every subsequent expression changes. The error is silent — the parser succeeds, the evaluator runs, the wrong thing happens. The gap between the intended tree and the actual tree is invisible in the source.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Why raw text fails" :id "why-text-fails" - (p "Claude Code reads " (code ".sx") " files as raw text and mentally reconstructs the tree structure by tracking bracket nesting. It does this imperfectly — especially in deep or wide trees where closing parentheses pile up and their correspondence to openers is lost. Consider the end of a complex island:") - (~docs/code :src "(set-cookie \"sx-home-stepper\" (freeze-to-sx \"home-stepper\"))))))))") - (p "Eight closing parentheses. Which one closes " (code "set-cookie") "? Which closes the " (code "fn") "? Which closes the binding pair? Which closes the letrec bindings list? Answering this requires counting backward through hundreds of lines. Counting is not what language models do well.") - (p "The same problem compounds when writing. Claude generates plausible-looking s-expression fragments that are structurally wrong — a paren added, a paren dropped, a level of nesting off. The " (code "str_replace") " tool makes this worse: replacing a string inside a deeply nested form can silently unbalance the surrounding structure in ways that are not visible until the file fails to parse — or worse, parses into a different tree.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "The fix: structural tools" :id "structural-tools" - (p "If Claude sees trees when the underlying thing is a tree, both the reading and writing problems disappear. Instead of raw text, Claude gets an annotated tree view with explicit paths:") - (~docs/code :src - (str "[0] (defisland ~home/stepper\n" - " [0,0] ~home/stepper\n" - " [0,1] ()\n" - " [0,2] (let\n" - " [0,2,0] let\n" - " [0,2,1] ((source ...) ... (code-tokens ...))\n" - " [0,2,2] (letrec\n" - " [0,2,2,0] letrec\n" - " [0,2,2,1] ((split-tag ...) ... (do-back ...))\n" - " [0,2,2,2] (freeze-scope ...)\n" - " [0,2,2,3] (let ((saved ...)) ...)\n" - " [0,2,2,4] (let ((parsed ...)) ...)\n" - " [0,2,2,5] (let ((_eff ...)) (div ...)))))")) - (p "The structural correspondence that is invisible in raw text is explicit here. Every node has a path. If " (code "rebuild-preview") " appears at " (code "[0,2,2,2]") " instead of " (code "[0,2,2,1,12]") ", it is immediately obvious that it is a body expression, not a letrec binding. The bug that took an hour to find would be visible on inspection.") - (p "For editing, Claude specifies tree operations rather than text replacements:") - (~docs/code :src - (str ";; Replace a node by path — the fragment is parsed before\n" - ";; the file is touched. Bracket errors are impossible.\n" - "(replace-node \"home-stepper.sx\" [0,2,2,1,12]\n" - " \"(rebuild-preview (fn (target) ...))\")\n" - "\n" - ";; Insert a new child at a specific position\n" - "(insert-child \"home-stepper.sx\" [0,2,2,1] 12\n" - " \"(new-function (fn () nil))\")\n" - "\n" - ";; Delete a node — siblings adjust automatically\n" - "(delete-node \"home-stepper.sx\" [0,2,2,3])")) - (p "Every write operation parses the new fragment as a complete s-expression " (em "before") " navigating to the target path. If the fragment is malformed, the operation returns an error with the line and column of the parse failure. The source file is never left in a partially-edited state. Bracket mismatches become impossible by construction.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Architecture" :id "architecture" - (p "SX Tools is an SX application. The comprehension and editing logic is written in SX, runs on the OCaml evaluator, and is exposed through two interfaces: an MCP server for Claude Code, and an interactive web application for the developer.") - (~docs/code :src - (str " ┌─────────────────┐\n" - " Claude Code ──▶ │ MCP Server │\n" - " │ (OCaml stdio) │\n" - " └────────┬─────────┘\n" - " │\n" - " ┌────────▼─────────┐\n" - " │ SX Tree Logic │\n" - " │ (comprehend.sx) │\n" - " │ (edit.sx) │\n" - " └────────┬─────────┘\n" - " │\n" - " ┌───────────────┼───────────────┐\n" - " ▼ ▼ ▼\n" - " .sx files Web tree editor Validation\n" - " (defisland) reports")) - (p "The " (strong "parser") " is " (code "sx-parse") " — the same parser that evaluates SX source. No new parser needed. Round-trip fidelity is inherited from the existing serializer.") - (p "The " (strong "tree logic") " lives in " (code "web/lib/tree-tools.sx") ". Pure functions: take a parsed tree, return annotated output or a modified tree. No IO, no side effects.") - (p "The " (strong "MCP server") " is a thin OCaml binary (" (code "hosts/ocaml/bin/mcp_tree.ml") ") that reads files, calls the SX tree functions via the OCaml bridge, and writes results. Stdio transport, JSON-RPC, single-threaded.") - (p "The " (strong "web editor") " is a " (code "defisland") " at " (code "/sx/(applications.(sx-tools))") " — the page you are reading. Interactive tree visualization with click-to-navigate, path display, and structural editing. Islands and signals make it reactive. It is both a tool and a demonstration of the SX platform.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Comprehension tools" :id "comprehension" - (p "These are the tools Claude uses to " (em "understand") " structure before touching anything. They are read-only and have no side effects. They are not a convenience layer — they are as important as the editing tools.") - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Annotated tree view") - (p "The primary comprehension tool. Every node gets its path label inline, making tree structure explicit. The structural correspondence that is invisible in raw text is readable by inspection, with no need to count brackets:") - (~docs/code :src - (str "[0] (defcomp ~card\n" - " [0,1] (&key title subtitle &rest children)\n" - " [0,2] (div :class \"card\"\n" - " [0,2,1] :class\n" - " [0,2,2] \"card\"\n" - " [0,2,3] (h2 title)\n" - " [0,2,4] (when subtitle (p subtitle))\n" - " [0,2,5] children))")) - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Structural summary") - (p "A folded view for large files, showing shape without detail. Claude orients itself in a 300-line island, identifies the region it needs, then calls " (code "read-subtree") " on just that part:") - (~docs/code :src - (str "(defisland ~home/stepper [0]\n" - " (let [0,2]\n" - " ((source ...) (code-tokens ...)) [0,2,1]\n" - " (letrec [0,2,2]\n" - " ((split-tag ...) ... [0,2,2,1]\n" - " (rebuild-preview ...) [0,2,2,1,12]\n" - " (do-back ...)) [0,2,2,1,13]\n" - " (freeze-scope ...) [0,2,2,2]\n" - " (let ((_eff ...)) (div ...)))) [0,2,2,5]")) - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Context view") - (p "Given a deep path, shows the enclosing chain back to the root. Essential for working deep in a tree without loading the entire file:") - (~docs/code :src - (str "Context for [0,2,2,1,12]:\n" - " [0] defisland ~home/stepper\n" - " [0,2] let ((source ...) ... (code-tokens ...))\n" - " [0,2,2] letrec ((split-tag ...) ...)\n" - " [0,2,2,1] bindings list (14 pairs)\n" - " → [0,2,2,1,12] (rebuild-preview (fn (target) ...))")) - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Bracket-paired view") - (p "The raw source annotated with matched pair labels, for cases where Claude needs to see the actual syntax and verify bracket correspondence:") - (~docs/code :src - (str "(₁defcomp ~card (₂&key title subtitle &rest children)₂\n" - " (₃div :class \"card\"\n" - " (₄h2 title)₄\n" - " (₅when subtitle (₆p subtitle)₆)₅\n" - " children)₃)₁"))) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Edit operations" :id "editing" - (p "All operations take a tree, perform the operation, and return either a new tree or a structured error. Nothing is mutated in place. File writing is a separate step that only happens after the edit succeeds.") - - (table :class "min-w-full text-sm mb-6" - (thead - (tr - (th :class "text-left pr-4 pb-2 font-semibold text-stone-700" "Operation") - (th :class "text-left pb-2 font-semibold text-stone-700" "Description"))) - (tbody :class "text-stone-600" - (tr (td :class "pr-4 py-1 font-mono text-xs" "replace-node") (td :class "py-1" "Replace the node at a path with new parsed source")) - (tr (td :class "pr-4 py-1 font-mono text-xs" "insert-child") (td :class "py-1" "Insert a new child at a specific index within a list")) - (tr (td :class "pr-4 py-1 font-mono text-xs" "delete-node") (td :class "py-1" "Remove a node — siblings shift to fill the gap")) - (tr (td :class "pr-4 py-1 font-mono text-xs" "wrap-node") (td :class "py-1" "Wrap a node in a new list — e.g. wrap expression in " (code "(when cond ...)"))) - (tr (td :class "pr-4 py-1 font-mono text-xs" "validate") (td :class "py-1" "Check structural integrity — balanced parens, valid paths")))) - - (p (strong "Fragment-first validation.") " Every write operation parses the new source fragment as a complete s-expression before navigating to the target path. If the fragment is malformed, the operation returns an error with the line and column of the parse failure. The source file is never touched in the failure path.") - (p (strong "Named paths.") " Index paths break when sibling nodes are inserted or deleted. Named paths — " (code "[Head \"letrec\", Head \"rebuild-preview\"]") " — survive structural edits and are more natural for Claude to reason about. Claude should prefer named paths; index paths are for mechanical follow-up after " (code "find-node") " has located a target.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "The protocol" :id "protocol" - (p "The tools only work if they are actually used. The MCP server must be accompanied by a protocol — enforced via " (code "CLAUDE.md") " — that prevents fallback to raw text editing.") - (~docs/code :src - (str ";; Before doing anything in an .sx file:\n" - ";; 1. summarise → structural overview of the whole file\n" - ";; 2. read-subtree → expand the region you intend to work in\n" - ";; 3. get-context → understand the position of specific nodes\n" - ";; 4. find-all → locate definitions or patterns by name\n" - "\n" - ";; For every edit:\n" - ";; 1. read-subtree → confirm the correct path\n" - ";; 2. replace-node / insert-child / delete-node / wrap-node\n" - ";; 3. validate → confirm structural integrity\n" - ";; 4. read-subtree → verify the result\n" - "\n" - ";; Never use str_replace on .sx files.\n" - ";; Never proceed to an edit without first establishing\n" - ";; where you are in the tree using the comprehension tools.")) - (p "The comprehension-first discipline is the key insight. Claude cannot edit reliably what it does not understand reliably. The same parsed tree representation serves both needs — reading and writing are two sides of the same structural problem.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Why SX, not OCaml" :id "why-sx" - (p "The original plan called for a pure OCaml implementation with " (code "angstrom") " parser combinators and a Wadler-Lindig pretty-printer. This is unnecessary. The SX ecosystem already has everything:") - (ul :class "space-y-2 text-stone-600" - (li (strong "Parser: ") (code "sx-parse") " already parses s-expressions correctly — it is the same parser the evaluator uses. No second parser to maintain, no divergence risk.") - (li (strong "Serializer: ") (code "sx-serialize") " already handles round-tripping. The existing serializer preserves structure.") - (li (strong "Tree operations: ") "Recursive list processing is what SX does best. Annotating a tree, folding to a summary, navigating by path — these are all natural " (code "map") "/" (code "reduce") "/" (code "filter") " operations on nested lists.") - (li (strong "Web UI: ") "The interactive tree editor is a " (code "defisland") " — signals for selection state, reactive DOM for the tree view, lakes for server-morphable content. The home stepper widget is proof this works.") - (li (strong "OCaml host: ") "The SX functions run on the OCaml evaluator. The MCP server is a thin OCaml wrapper around SX function calls. Native performance for the server, WASM for the browser — same codebase.")) - (p "Writing the tree tools in SX means they can run in the browser (via the WASM evaluator) and on the server (via the OCaml kernel). The web editor and the MCP server share identical logic. There is one implementation, not two.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Build plan" :id "build-plan" - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 1 — Tree comprehension functions") - (p "Implement " (code "annotate-tree") ", " (code "summarise") ", " (code "read-subtree") ", " (code "get-context") ", " (code "find-all") ", " (code "bracket-pairs") " as pure SX functions in " (code "web/lib/tree-tools.sx") ". Test against real project " (code ".sx") " files. Iterate on output formats until the output is genuinely easy for a language model to read — the format is load-bearing.") - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 2 — Edit operations") - (p "Implement " (code "replace-node") ", " (code "insert-child") ", " (code "delete-node") ", " (code "wrap-node") ", " (code "validate") " as pure SX functions. Fragment-first validation on all write operations. Test error paths exhaustively — error messages are part of the interface.") - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 3 — MCP server") - (p "Thin OCaml binary: stdio JSON-RPC, calls SX functions via the bridge, reads/writes files. Wire all comprehension and edit tools to MCP handlers. Manual testing with raw JSON.") - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 4 — Web editor") - (p (code "defisland ~sx-tools/tree-editor") " — interactive tree visualization on this page. Click a node to see its path, context, and siblings. Edit nodes through a structural interface. Islands and signals for reactivity. A tool and a demonstration.") - - (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 5 — Integration and iteration") - (p "Write the " (code "CLAUDE.md") " protocol. Run real tasks with Claude Code — both reading and editing. Observe which comprehension tools Claude actually reaches for. Observe where it still makes structural errors. Iterate on output formats and add any missing tools. The output formats deserve careful design based on observed behaviour, not just on what seems reasonable in advance.")) - - ;; ----------------------------------------------------------------- - (~docs/section :title "Try it" :id "try-it" - (p "Paste or edit SX source below. The tree view shows every node with its path — click a node to select it, then switch to context view to see the enclosing chain.") - (~sx-tools/tree-editor)) - - ;; ----------------------------------------------------------------- - (~docs/section :title "What changes" :id "what-changes" - (p "With SX Tools, the debugging session that found the home-stepper bug would not have happened. The workflow would have been:") - (ul :class "space-y-2 text-stone-600" - (li (code "summarise home-stepper.sx") " → see that " (code "rebuild-preview") " is at " (code "[0,4]") " (body expression) instead of " (code "[0,2,2,1,12]") " (letrec binding). The bug is visible on the summary.") - (li "Even without noticing the summary, " (code "validate home-stepper.sx") " would report the structural anomaly: 14 names in the letrec bindings list but only 12 binding pairs, with 2 bare expressions following.") - (li "The fix — " (code "delete-node") " to remove the extra paren, or " (code "wrap-node") " to restructure — would be a tree operation. No character-counting, no mental stack simulation, no risk of introducing a second paren error while fixing the first.")) - (p "The gap between intended tree and actual tree stops being invisible. Claude sees trees, edits trees, and the brackets take care of themselves.")))) +(defcomp ~sx-tools/overview-content (&key (title "SX Tools") &rest extra) (~docs/page :title title (p :class "text-stone-500 text-sm italic mb-8" "A structural tree editor for s-expression files — because the thing that reads and edits code should understand the code as a tree, not as a sequence of characters.") (~docs/section :title "The problem" :id "problem" (p "On 25 March 2026, the SX documentation site went blank. The home page stepper widget — a 310-line " (code "defisland") " — failed to render. The cause was a single extra closing parenthesis on line 222 of " (code "home-stepper.sx") ".") (p "That parenthesis closed the " (code "letrec") " bindings list one level too early. Two function definitions — " (code "rebuild-preview") " and " (code "do-back") " — silently became body expressions instead of bindings. They were evaluated and discarded rather than bound in scope. Every subsequent reference to " (code "rebuild-preview") " raised " (code "Undefined symbol") ". The island rendered nothing. The page went white.") (p "Finding this took an hour of systematic debugging: adding trace output to the OCaml " (code "env_has") " function, dumping the scope chain at the point of failure, counting keys in the letrec environment (" (em "12 where there should have been 14") "), and finally writing a paren-depth tracer that walked the file character by character to find where the nesting diverged from expectation.") (p "The fix was removing one character.") (p "This is a class of bug, not an incident. S-expressions encode tree structure in linear text using matched delimiters. When those delimiters are wrong, the meaning of every subsequent expression changes. The error is silent — the parser succeeds, the evaluator runs, the wrong thing happens. The gap between the intended tree and the actual tree is invisible in the source.")) (~docs/section :title "Why raw text fails" :id "why-text-fails" (p "Claude Code reads " (code ".sx") " files as raw text and mentally reconstructs the tree structure by tracking bracket nesting. It does this imperfectly — especially in deep or wide trees where closing parentheses pile up and their correspondence to openers is lost. Consider the end of a complex island:") (~docs/code :src "(set-cookie \"sx-home-stepper\" (freeze-to-sx \"home-stepper\"))))))))") (p "Eight closing parentheses. Which one closes " (code "set-cookie") "? Which closes the " (code "fn") "? Which closes the binding pair? Which closes the letrec bindings list? Answering this requires counting backward through hundreds of lines. Counting is not what language models do well.") (p "The same problem compounds when writing. Claude generates plausible-looking s-expression fragments that are structurally wrong — a paren added, a paren dropped, a level of nesting off. The " (code "str_replace") " tool makes this worse: replacing a string inside a deeply nested form can silently unbalance the surrounding structure in ways that are not visible until the file fails to parse — or worse, parses into a different tree.")) (~docs/section :title "The fix: structural tools" :id "structural-tools" (p "If Claude sees trees when the underlying thing is a tree, both the reading and writing problems disappear. Instead of raw text, Claude gets an annotated tree view with explicit paths:") (~docs/code :src (str "[0] (defisland ~home/stepper\n" " [0,0] ~home/stepper\n" " [0,1] ()\n" " [0,2] (let\n" " [0,2,0] let\n" " [0,2,1] ((source ...) ... (code-tokens ...))\n" " [0,2,2] (letrec\n" " [0,2,2,0] letrec\n" " [0,2,2,1] ((split-tag ...) ... (do-back ...))\n" " [0,2,2,2] (freeze-scope ...)\n" " [0,2,2,3] (let ((saved ...)) ...)\n" " [0,2,2,4] (let ((parsed ...)) ...)\n" " [0,2,2,5] (let ((_eff ...)) (div ...)))))")) (p "The structural correspondence that is invisible in raw text is explicit here. Every node has a path. If " (code "rebuild-preview") " appears at " (code "[0,2,2,2]") " instead of " (code "[0,2,2,1,12]") ", it is immediately obvious that it is a body expression, not a letrec binding. The bug that took an hour to find would be visible on inspection.") (p "For editing, Claude specifies tree operations rather than text replacements:") (~docs/code :src (str ";; Replace a node by path — the fragment is parsed before\n" ";; the file is touched. Bracket errors are impossible.\n" "(replace-node \"home-stepper.sx\" [0,2,2,1,12]\n" " \"(rebuild-preview (fn (target) ...))\")\n" "\n" ";; Insert a new child at a specific position\n" "(insert-child \"home-stepper.sx\" [0,2,2,1] 12\n" " \"(new-function (fn () nil))\")\n" "\n" ";; Delete a node — siblings adjust automatically\n" "(delete-node \"home-stepper.sx\" [0,2,2,3])")) (p "Every write operation parses the new fragment as a complete s-expression " (em "before") " navigating to the target path. If the fragment is malformed, the operation returns an error with the line and column of the parse failure. The source file is never left in a partially-edited state. Bracket mismatches become impossible by construction.")) (~docs/section :title "Architecture" :id "architecture" (p "SX Tools is an SX application. The comprehension and editing logic is written in SX, runs on the OCaml evaluator, and is exposed through two interfaces: an MCP server for Claude Code, and an interactive web application for the developer.") (~docs/code :src (str " ┌─────────────────┐\n" " Claude Code ──▶ │ MCP Server │\n" " │ (OCaml stdio) │\n" " └────────┬─────────┘\n" " │\n" " ┌────────▼─────────┐\n" " │ SX Tree Logic │\n" " │ (comprehend.sx) │\n" " │ (edit.sx) │\n" " └────────┬─────────┘\n" " │\n" " ┌───────────────┼───────────────┐\n" " ▼ ▼ ▼\n" " .sx files Web tree editor Validation\n" " (defisland) reports")) (p "The " (strong "parser") " is " (code "sx-parse") " — the same parser that evaluates SX source. No new parser needed. Round-trip fidelity is inherited from the existing serializer.") (p "The " (strong "tree logic") " lives in " (code "web/lib/tree-tools.sx") ". Pure functions: take a parsed tree, return annotated output or a modified tree. No IO, no side effects.") (p "The " (strong "MCP server") " is a thin OCaml binary (" (code "hosts/ocaml/bin/mcp_tree.ml") ") that reads files, calls the SX tree functions via the OCaml bridge, and writes results. Stdio transport, JSON-RPC, single-threaded.") (p "The " (strong "web editor") " is a " (code "defisland") " at " (code "/sx/(applications.(sx-tools))") " — the page you are reading. Interactive tree visualization with click-to-navigate, path display, and structural editing. Islands and signals make it reactive. It is both a tool and a demonstration of the SX platform.")) (~docs/section :title "Comprehension tools" :id "comprehension" (p "These are the tools Claude uses to " (em "understand") " structure before touching anything. They are read-only and have no side effects. They are not a convenience layer — they are as important as the editing tools.") (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Annotated tree view") (p "The primary comprehension tool. Every node gets its path label inline, making tree structure explicit. The structural correspondence that is invisible in raw text is readable by inspection, with no need to count brackets:") (~docs/code :src (str "[0] (defcomp ~card\n" " [0,1] (&key title subtitle &rest children)\n" " [0,2] (div :class \"card\"\n" " [0,2,1] :class\n" " [0,2,2] \"card\"\n" " [0,2,3] (h2 title)\n" " [0,2,4] (when subtitle (p subtitle))\n" " [0,2,5] children))")) (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Structural summary") (p "A folded view for large files, showing shape without detail. Claude orients itself in a 300-line island, identifies the region it needs, then calls " (code "read-subtree") " on just that part:") (~docs/code :src (str "(defisland ~home/stepper [0]\n" " (let [0,2]\n" " ((source ...) (code-tokens ...)) [0,2,1]\n" " (letrec [0,2,2]\n" " ((split-tag ...) ... [0,2,2,1]\n" " (rebuild-preview ...) [0,2,2,1,12]\n" " (do-back ...)) [0,2,2,1,13]\n" " (freeze-scope ...) [0,2,2,2]\n" " (let ((_eff ...)) (div ...)))) [0,2,2,5]")) (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Context view") (p "Given a deep path, shows the enclosing chain back to the root. Essential for working deep in a tree without loading the entire file:") (~docs/code :src (str "Context for [0,2,2,1,12]:\n" " [0] defisland ~home/stepper\n" " [0,2] let ((source ...) ... (code-tokens ...))\n" " [0,2,2] letrec ((split-tag ...) ...)\n" " [0,2,2,1] bindings list (14 pairs)\n" " → [0,2,2,1,12] (rebuild-preview (fn (target) ...))")) (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Bracket-paired view") (p "The raw source annotated with matched pair labels, for cases where Claude needs to see the actual syntax and verify bracket correspondence:") (~docs/code :src (str "(₁defcomp ~card (₂&key title subtitle &rest children)₂\n" " (₃div :class \"card\"\n" " (₄h2 title)₄\n" " (₅when subtitle (₆p subtitle)₆)₅\n" " children)₃)₁"))) (~docs/section :title "Edit operations" :id "editing" (p "All operations take a tree, perform the operation, and return either a new tree or a structured error. Nothing is mutated in place. File writing is a separate step that only happens after the edit succeeds.") (table :class "min-w-full text-sm mb-6" (thead (tr (th :class "text-left pr-4 pb-2 font-semibold text-stone-700" "Operation") (th :class "text-left pb-2 font-semibold text-stone-700" "Description"))) (tbody :class "text-stone-600" (tr (td :class "pr-4 py-1 font-mono text-xs" "replace-node") (td :class "py-1" "Replace the node at a path with new parsed source")) (tr (td :class "pr-4 py-1 font-mono text-xs" "insert-child") (td :class "py-1" "Insert a new child at a specific index within a list")) (tr (td :class "pr-4 py-1 font-mono text-xs" "delete-node") (td :class "py-1" "Remove a node — siblings shift to fill the gap")) (tr (td :class "pr-4 py-1 font-mono text-xs" "wrap-node") (td :class "py-1" "Wrap a node in a new list — e.g. wrap expression in " (code "(when cond ...)"))) (tr (td :class "pr-4 py-1 font-mono text-xs" "validate") (td :class "py-1" "Check structural integrity — balanced parens, valid paths")))) (p (strong "Fragment-first validation.") " Every write operation parses the new source fragment as a complete s-expression before navigating to the target path. If the fragment is malformed, the operation returns an error with the line and column of the parse failure. The source file is never touched in the failure path.") (p (strong "Named paths.") " Index paths break when sibling nodes are inserted or deleted. Named paths — " (code "[Head \"letrec\", Head \"rebuild-preview\"]") " — survive structural edits and are more natural for Claude to reason about. Claude should prefer named paths; index paths are for mechanical follow-up after " (code "find-node") " has located a target.")) (~docs/section :title "The protocol" :id "protocol" (p "The tools only work if they are actually used. The MCP server must be accompanied by a protocol — enforced via " (code "CLAUDE.md") " — that prevents fallback to raw text editing.") (~docs/code :src (str ";; Before doing anything in an .sx file:\n" ";; 1. summarise → structural overview of the whole file\n" ";; 2. read-subtree → expand the region you intend to work in\n" ";; 3. get-context → understand the position of specific nodes\n" ";; 4. find-all → locate definitions or patterns by name\n" "\n" ";; For every edit:\n" ";; 1. read-subtree → confirm the correct path\n" ";; 2. replace-node / insert-child / delete-node / wrap-node\n" ";; 3. validate → confirm structural integrity\n" ";; 4. read-subtree → verify the result\n" "\n" ";; Never use str_replace on .sx files.\n" ";; Never proceed to an edit without first establishing\n" ";; where you are in the tree using the comprehension tools.")) (p "The comprehension-first discipline is the key insight. Claude cannot edit reliably what it does not understand reliably. The same parsed tree representation serves both needs — reading and writing are two sides of the same structural problem.")) (~docs/section :title "Why SX, not OCaml" :id "why-sx" (p "The original plan called for a pure OCaml implementation with " (code "angstrom") " parser combinators and a Wadler-Lindig pretty-printer. This is unnecessary. The SX ecosystem already has everything:") (ul :class "space-y-2 text-stone-600" (li (strong "Parser: ") (code "sx-parse") " already parses s-expressions correctly — it is the same parser the evaluator uses. No second parser to maintain, no divergence risk.") (li (strong "Serializer: ") (code "sx-serialize") " already handles round-tripping. The existing serializer preserves structure.") (li (strong "Tree operations: ") "Recursive list processing is what SX does best. Annotating a tree, folding to a summary, navigating by path — these are all natural " (code "map") "/" (code "reduce") "/" (code "filter") " operations on nested lists.") (li (strong "Web UI: ") "The interactive tree editor is a " (code "defisland") " — signals for selection state, reactive DOM for the tree view, lakes for server-morphable content. The home stepper widget is proof this works.") (li (strong "OCaml host: ") "The SX functions run on the OCaml evaluator. The MCP server is a thin OCaml wrapper around SX function calls. Native performance for the server, WASM for the browser — same codebase.")) (p "Writing the tree tools in SX means they can run in the browser (via the WASM evaluator) and on the server (via the OCaml kernel). The web editor and the MCP server share identical logic. There is one implementation, not two.")) (~docs/section :title "Build plan" :id "build-plan" (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 1 — Tree comprehension functions") (p "Implement " (code "annotate-tree") ", " (code "summarise") ", " (code "read-subtree") ", " (code "get-context") ", " (code "find-all") ", " (code "bracket-pairs") " as pure SX functions in " (code "web/lib/tree-tools.sx") ". Test against real project " (code ".sx") " files. Iterate on output formats until the output is genuinely easy for a language model to read — the format is load-bearing.") (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 2 — Edit operations") (p "Implement " (code "replace-node") ", " (code "insert-child") ", " (code "delete-node") ", " (code "wrap-node") ", " (code "validate") " as pure SX functions. Fragment-first validation on all write operations. Test error paths exhaustively — error messages are part of the interface.") (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 3 — MCP server") (p "Thin OCaml binary: stdio JSON-RPC, calls SX functions via the bridge, reads/writes files. Wire all comprehension and edit tools to MCP handlers. Manual testing with raw JSON.") (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 4 — Web editor") (p (code "defisland ~sx-tools/tree-editor") " — interactive tree visualization on this page. Click a node to see its path, context, and siblings. Edit nodes through a structural interface. Islands and signals for reactivity. A tool and a demonstration.") (h4 :class "font-semibold text-stone-700 mt-6 mb-2" "Phase 5 — Integration and iteration") (p "Write the " (code "CLAUDE.md") " protocol. Run real tasks with Claude Code — both reading and editing. Observe which comprehension tools Claude actually reaches for. Observe where it still makes structural errors. Iterate on output formats and add any missing tools. The output formats deserve careful design based on observed behaviour, not just on what seems reasonable in advance.")) (~docs/section :title "Try it" :id "try-it" (p "Paste or edit SX source below. The tree view shows every node with its path — click a node to select it, then switch to context view to see the enclosing chain.") (~sx-tools/tree-editor)) (~docs/section :title "What changes" :id "what-changes" (p "With SX Tools, the debugging session that found the home-stepper bug would not have happened. The workflow would have been:") (ul :class "space-y-2 text-stone-600" (li (code "summarise home-stepper.sx") " → see that " (code "rebuild-preview") " is at " (code "[0,4]") " (body expression) instead of " (code "[0,2,2,1,12]") " (letrec binding). The bug is visible on the summary.") (li "Even without noticing the summary, " (code "validate home-stepper.sx") " would report the structural anomaly: 14 names in the letrec bindings list but only 12 binding pairs, with 2 bare expressions following.") (li "The fix — " (code "delete-node") " to remove the extra paren, or " (code "wrap-node") " to restructure — would be a tree operation. No character-counting, no mental stack simulation, no risk of introducing a second paren error while fixing the first.")) (p "The gap between intended tree and actual tree stops being invisible. Claude sees trees, edits trees, and the brackets take care of themselves."))))