Add HyperSX view tab: indentation-based alternative syntax for SX
sx->hypersx transform converts parsed SX to a readable indentation-based
format: CSS selector shorthand (div.card#main), signal sugar (@count,
signal(), :=, <-), string interpolation ("Count: {@count}"), and
structural keywords (when, if, let, map, for).
Implemented as pure SX in web/lib/hypersx.sx, loaded in browser via
js_of_ocaml platform. Added as "hypersx" tab in the tree editor.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
75
hosts/ocaml/browser/bundle.sh
Executable file
75
hosts/ocaml/browser/bundle.sh
Executable file
@@ -0,0 +1,75 @@
|
||||
#!/bin/bash
|
||||
# Bundle the WASM SX kernel + platform + .sx files for serving.
|
||||
#
|
||||
# Output goes to hosts/ocaml/browser/dist/
|
||||
# Serve dist/ at /wasm/ or similar path.
|
||||
|
||||
set -e
|
||||
cd "$(dirname "$0")"
|
||||
|
||||
BUILD=../_build/default/browser
|
||||
DIST=dist
|
||||
ROOT=../../..
|
||||
|
||||
echo "=== Bundling SX WASM browser engine ==="
|
||||
|
||||
rm -rf "$DIST"
|
||||
mkdir -p "$DIST/sx"
|
||||
|
||||
# 1. WASM kernel
|
||||
cp "$BUILD/sx_browser.bc.wasm.js" "$DIST/"
|
||||
cp -r "$BUILD/sx_browser.bc.wasm.assets" "$DIST/"
|
||||
|
||||
# Also copy js_of_ocaml version as fallback
|
||||
cp "$BUILD/sx_browser.bc.js" "$DIST/"
|
||||
|
||||
# 2. Platform JS
|
||||
cp sx-platform.js "$DIST/"
|
||||
|
||||
# 3. Spec modules
|
||||
cp "$ROOT/spec/render.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/signals.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/deps.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/router.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/page-helpers.sx" "$DIST/sx/"
|
||||
|
||||
# 3b. Freeze scope (signal persistence)
|
||||
cp "$ROOT/lib/freeze.sx" "$DIST/sx/"
|
||||
|
||||
# 4. Bytecode compiler + VM
|
||||
cp "$ROOT/lib/bytecode.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/compiler.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/vm.sx" "$DIST/sx/"
|
||||
|
||||
# 5. Web libraries (8 FFI primitives)
|
||||
cp "$ROOT/web/lib/dom.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/lib/browser.sx" "$DIST/sx/"
|
||||
|
||||
# 6. Web adapters
|
||||
cp "$ROOT/web/adapter-html.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-sx.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-dom.sx" "$DIST/sx/"
|
||||
|
||||
# 7. Boot helpers (platform functions in pure SX)
|
||||
cp "$ROOT/web/lib/boot-helpers.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/lib/hypersx.sx" "$DIST/sx/"
|
||||
|
||||
# 8. Web framework
|
||||
cp "$ROOT/web/engine.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/orchestration.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/boot.sx" "$DIST/sx/"
|
||||
|
||||
# Summary
|
||||
WASM_SIZE=$(du -sh "$DIST/sx_browser.bc.wasm.assets" | cut -f1)
|
||||
JS_SIZE=$(du -sh "$DIST/sx_browser.bc.js" | cut -f1)
|
||||
SX_SIZE=$(du -sh "$DIST/sx" | cut -f1)
|
||||
echo " WASM kernel: $WASM_SIZE (assets)"
|
||||
echo " JS fallback: $JS_SIZE"
|
||||
echo " SX sources: $SX_SIZE ($(ls "$DIST/sx/" | wc -l) files)"
|
||||
echo " Platform JS: $(du -sh "$DIST/sx-platform.js" | cut -f1)"
|
||||
echo ""
|
||||
echo " dist/ ready to serve"
|
||||
echo ""
|
||||
echo " HTML usage:"
|
||||
echo ' <script src="/wasm/sx_browser.bc.wasm.js"></script>'
|
||||
echo ' <script src="/wasm/sx-platform.js"></script>'
|
||||
@@ -253,6 +253,7 @@
|
||||
"sx/adapter-dom.sx",
|
||||
// Boot helpers (platform functions in pure SX)
|
||||
"sx/boot-helpers.sx",
|
||||
"sx/hypersx.sx",
|
||||
// Web framework
|
||||
"sx/engine.sx",
|
||||
"sx/orchestration.sx",
|
||||
|
||||
File diff suppressed because one or more lines are too long
25
web/lib/hypersx.sx
Normal file
25
web/lib/hypersx.sx
Normal file
@@ -0,0 +1,25 @@
|
||||
(define hsx-indent (fn (depth) (let ((result "")) (for-each (fn (_) (set! result (str result " "))) (range 0 depth)) result)))
|
||||
|
||||
(define hsx-sym-name (fn (node) (if (= (type-of node) "symbol") (symbol-name node) nil)))
|
||||
|
||||
(define hsx-kw-name (fn (node) (if (= (type-of node) "keyword") (keyword-name node) nil)))
|
||||
|
||||
(define hsx-is-element? (fn (name) (and name (not (starts-with? name "~")) (is-html-tag? name))))
|
||||
|
||||
(define hsx-is-component? (fn (name) (and name (starts-with? name "~"))))
|
||||
|
||||
(define hsx-extract-css (fn (args) (let ((classes nil) (id nil) (rest-attrs (list)) (i 0) (n (len args))) (letrec ((walk (fn () (when (< i n) (let ((kn (hsx-kw-name (nth args i)))) (cond (= kn "class") (do (set! classes (nth args (+ i 1))) (set! i (+ i 2)) (walk)) (= kn "id") (do (set! id (nth args (+ i 1))) (set! i (+ i 2)) (walk)) kn (do (append! rest-attrs (nth args i)) (append! rest-attrs (nth args (+ i 1))) (set! i (+ i 2)) (walk)) :else nil)))))) (walk) (dict "classes" classes "id" id "attrs" rest-attrs "children" (if (< i n) (slice args i) (list)))))))
|
||||
|
||||
(define hsx-tag-str (fn (name css) (let ((s name) (cls (get css "classes")) (eid (get css "id"))) (when (and cls (string? cls)) (for-each (fn (c) (set! s (str s "." c))) (split cls " "))) (when eid (set! s (str s "#" eid))) s)))
|
||||
|
||||
(define hsx-atom (fn (node) (cond (nil? node) "nil" (string? node) (str "\"" node "\"") (number? node) (str node) (= (type-of node) "boolean") (if node "true" "false") (= (type-of node) "symbol") (str "{" (symbol-name node) "}") (= (type-of node) "keyword") (str ":" (keyword-name node)) :else (sx-serialize node))))
|
||||
|
||||
(define hsx-inline (fn (node) (cond (not (list? node)) (sx-serialize node) (empty? node) "()" :else (let ((hd (hsx-sym-name (first node)))) (cond (= hd "deref") (str "@" (sx-serialize (nth node 1))) (= hd "signal") (str "signal(" (if (> (len node) 1) (hsx-inline (nth node 1)) "") ")") (= hd "reset!") (str (sx-serialize (nth node 1)) " := " (hsx-inline (nth node 2))) (= hd "swap!") (str (sx-serialize (nth node 1)) " <- " (hsx-inline (nth node 2))) (= hd "str") (str "\"" (join "" (map (fn (a) (if (string? a) a (str "{" (hsx-inline a) "}"))) (rest node))) "\"") :else (str "(" (sx-serialize (first node)) (if (> (len node) 1) (str " " (join " " (map hsx-inline (rest node)))) "") ")"))))))
|
||||
|
||||
(define hsx-attrs-str (fn (attrs) (if (empty? attrs) "" (let ((parts (list)) (i 0)) (letrec ((walk (fn () (when (< i (len attrs)) (append! parts (str ":" (keyword-name (nth attrs i)) " " (hsx-atom (nth attrs (+ i 1))))) (set! i (+ i 2)) (walk))))) (walk)) (str " " (join " " parts))))))
|
||||
|
||||
(define hsx-children (fn (line kids depth) (if (empty? kids) line (if (and (= (len kids) 1) (not (list? (first kids)))) (str line " " (hsx-atom (first kids))) (str line "\n" (join "\n" (map (fn (c) (sx->hypersx-node c (+ depth 1))) kids)))))))
|
||||
|
||||
(define sx->hypersx-node (fn (node depth) (let ((pad (hsx-indent depth))) (cond (nil? node) (str pad "nil") (not (list? node)) (str pad (hsx-atom node)) (empty? node) (str pad "()") :else (let ((hd (hsx-sym-name (first node)))) (cond (= hd "str") (str pad (hsx-inline node)) (= hd "deref") (str pad (hsx-inline node)) (= hd "reset!") (str pad (hsx-inline node)) (= hd "swap!") (str pad (hsx-inline node)) (= hd "signal") (str pad (hsx-inline node)) (or (= hd "defcomp") (= hd "defisland")) (str pad hd " " (sx-serialize (nth node 1)) " " (sx-serialize (nth node 2)) "\n" (sx->hypersx-node (last node) (+ depth 1))) (= hd "when") (str pad "when " (hsx-inline (nth node 1)) "\n" (join "\n" (map (fn (c) (sx->hypersx-node c (+ depth 1))) (slice node 2)))) (= hd "if") (let ((test (nth node 1)) (then-b (nth node 2)) (else-b (if (> (len node) 3) (nth node 3) nil))) (if (and (not (list? then-b)) (or (nil? else-b) (not (list? else-b)))) (str pad "if " (hsx-inline test) " " (hsx-atom then-b) (if else-b (str " " (hsx-atom else-b)) "")) (str pad "if " (hsx-inline test) "\n" (sx->hypersx-node then-b (+ depth 1)) (if else-b (str "\n" pad "else\n" (sx->hypersx-node else-b (+ depth 1))) "")))) (or (= hd "let") (= hd "letrec") (= hd "let*")) (let ((binds (nth node 1)) (body (slice node 2))) (str pad hd " " (join ", " (map (fn (b) (if (and (list? b) (>= (len b) 2)) (str (sx-serialize (first b)) " = " (hsx-inline (nth b 1))) (sx-serialize b))) (if (and (list? binds) (not (empty? binds)) (list? (first binds))) binds (list binds)))) "\n" (join "\n" (map (fn (b) (sx->hypersx-node b (+ depth 1))) body)))) (and (= hd "map") (= (len node) 3) (list? (nth node 1)) (= (hsx-sym-name (first (nth node 1))) "fn")) (let ((fn-node (nth node 1)) (coll (nth node 2))) (str pad "map " (hsx-inline coll) " -> " (sx-serialize (nth fn-node 1)) "\n" (sx->hypersx-node (last fn-node) (+ depth 1)))) (and (= hd "for-each") (= (len node) 3) (list? (nth node 1)) (= (hsx-sym-name (first (nth node 1))) "fn")) (let ((fn-node (nth node 1)) (coll (nth node 2))) (str pad "for " (sx-serialize (nth fn-node 1)) " in " (hsx-inline coll) "\n" (sx->hypersx-node (last fn-node) (+ depth 1)))) (hsx-is-element? hd) (let ((css (hsx-extract-css (rest node)))) (hsx-children (str pad (hsx-tag-str hd css) (hsx-attrs-str (get css "attrs"))) (get css "children") depth)) (hsx-is-component? hd) (let ((css (hsx-extract-css (rest node)))) (hsx-children (str pad hd (hsx-attrs-str (get css "attrs"))) (get css "children") depth)) :else (str pad (sx-serialize node))))))))
|
||||
|
||||
(define sx->hypersx (fn (tree) (join "\n\n" (map (fn (expr) (sx->hypersx-node expr 0)) tree))))
|
||||
Reference in New Issue
Block a user