Highlight returns SX tree, rendered to HTML/DOM by pipeline

highlight.sx now returns a list of (span :class "..." "text") elements
instead of a string. The rendering pipeline handles the rest:
- Server render-to-html: produces <span class="...">text</span>
- Client render-to-dom: produces DOM span elements
- Aser: serializes spans as SX for client rendering

Key fixes:
- hl-span uses (make-keyword "class") not :class (keywords evaluate
  to strings in list context)
- render-sx-tokens returns flat list of spans (no wrapper)
- hl-escape is identity (no escaping needed for tree values)
- highlight.sx added to browser bundle + platform loader
- ~docs/code renders src directly as child of pre

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-31 23:12:36 +00:00
parent 609be68c9c
commit b62dfb25e5
12 changed files with 901 additions and 650 deletions

View File

@@ -34,8 +34,9 @@ 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)
# 3b. Freeze scope (signal persistence) + highlight (syntax coloring)
cp "$ROOT/lib/freeze.sx" "$DIST/sx/"
cp "$ROOT/lib/highlight.sx" "$DIST/sx/"
# 4. Bytecode compiler + VM
cp "$ROOT/lib/bytecode.sx" "$DIST/sx/"

View File

@@ -301,8 +301,9 @@
"sx/deps.sx",
"sx/router.sx",
"sx/page-helpers.sx",
// Freeze scope (signal persistence)
// Freeze scope (signal persistence) + highlight (syntax coloring)
"sx/freeze.sx",
"sx/highlight.sx",
// Bytecode compiler + VM
"sx/bytecode.sx",
"sx/compiler.sx",

View File

@@ -67,36 +67,7 @@
(define hl-ws? (fn (c) (or (= c " ") (= c "\n") (= c "\t") (= c "\r"))))
(define
hl-escape
(fn
(s)
(let
((result "") (i 0) (len (string-length s)))
(let
loop
()
(when
(< i len)
(let
((c (substring s i (+ i 1))))
(set!
result
(str
result
(if
(= c "\\")
"\\\\"
(if
(= c "\"")
"\\\""
(if
(= c "\n")
"\\n"
(if (= c "\t") "\\t" (if (= c "\r") "\\r" c)))))))
(set! i (+ i 1))
(loop))))
result)))
(define hl-escape (fn (s) s))
(define
hl-span
@@ -104,8 +75,8 @@
(class text)
(if
(= class "")
(str "(span \"" (hl-escape text) "\")")
(str "(span :class \"" class "\" \"" (hl-escape text) "\")"))))
(list (quote span) text)
(list (quote span) (make-keyword "class") class text))))
(define
tokenize-sx
@@ -309,9 +280,13 @@
render-sx-tokens
(fn
(tokens)
(let
((parts (map (fn (tok) (let ((kind (first tok)) (text (first (rest tok)))) (hl-span (get sx-token-classes kind "") text))) tokens)))
(str "(<> " (join " " parts) ")"))))
(map
(fn
(tok)
(let
((cls (or (dict-get sx-token-classes (first tok)) "")))
(hl-span cls (nth tok 1))))
tokens)))
(define highlight-sx (fn (code) (render-sx-tokens (tokenize-sx code))))
@@ -322,7 +297,4 @@
(if
(or (= lang "lisp") (= lang "sx") (= lang "sexp") (= lang "scheme"))
(highlight-sx code)
(str
"(pre :class \"text-sm overflow-x-auto\" (code \""
(hl-escape code)
"\"))"))))
(list (quote code) code))))

View File

@@ -301,8 +301,9 @@
"sx/deps.sx",
"sx/router.sx",
"sx/page-helpers.sx",
// Freeze scope (signal persistence)
// Freeze scope (signal persistence) + highlight (syntax coloring)
"sx/freeze.sx",
"sx/highlight.sx",
// Bytecode compiler + VM
"sx/bytecode.sx",
"sx/compiler.sx",

View File

@@ -0,0 +1,300 @@
(define
sx-specials
(list
"defcomp"
"defrelation"
"defisland"
"defpage"
"defhelper"
"define"
"defmacro"
"defconfig"
"deftest"
"if"
"when"
"cond"
"case"
"and"
"or"
"not"
"let"
"let*"
"lambda"
"fn"
"do"
"begin"
"quote"
"quasiquote"
"->"
"map"
"filter"
"reduce"
"some"
"every?"
"map-indexed"
"for-each"
"&key"
"&rest"
"set!"))
(define sx-special? (fn (s) (some (fn (x) (= x s)) sx-specials)))
(define hl-digit? (fn (c) (and (>= c "0") (<= c "9"))))
(define
hl-alpha?
(fn (c) (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")))))
(define
hl-sym-char?
(fn
(c)
(or
(hl-alpha? c)
(hl-digit? c)
(= c "_")
(= c "-")
(= c "?")
(= c "!")
(= c "+")
(= c "*")
(= c "/")
(= c "<")
(= c ">")
(= c "=")
(= c "&")
(= c "."))))
(define hl-ws? (fn (c) (or (= c " ") (= c "\n") (= c "\t") (= c "\r"))))
(define hl-escape (fn (s) s))
(define
hl-span
(fn
(class text)
(if
(= class "")
(list (quote span) text)
(list (quote span) (make-keyword "class") class text))))
(define
tokenize-sx
(fn
(code)
(let
((tokens (list)) (i 0) (len (string-length code)))
(let
loop
()
(when
(< i len)
(let
((c (substring code i (+ i 1))))
(if
(= c ";")
(let
((start i))
(set! i (+ i 1))
(let
scan
()
(when
(and
(< i len)
(not (= (substring code i (+ i 1)) "\n")))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "comment" (substring code start i))))))
(if
(= c "\"")
(let
((start i))
(set! i (+ i 1))
(let
sloop
()
(when
(< i len)
(let
((sc (substring code i (+ i 1))))
(if
(= sc "\\")
(do (set! i (+ i 2)) (sloop))
(if
(= sc "\"")
(set! i (+ i 1))
(do (set! i (+ i 1)) (sloop)))))))
(set!
tokens
(append
tokens
(list (list "string" (substring code start i))))))
(if
(= c ":")
(let
((start i))
(set! i (+ i 1))
(when
(and
(< i len)
(hl-alpha? (substring code i (+ i 1))))
(let
scan
()
(when
(and
(< i len)
(hl-sym-char? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan))))
(set!
tokens
(append
tokens
(list (list "keyword" (substring code start i))))))
(if
(= c "~")
(let
((start i))
(set! i (+ i 1))
(let
scan
()
(when
(and
(< i len)
(let
((x (substring code i (+ i 1))))
(or (hl-sym-char? x) (= x "/"))))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "component" (substring code start i))))))
(if
(or
(= c "(")
(= c ")")
(= c "[")
(= c "]")
(= c "{")
(= c "}"))
(do
(set!
tokens
(append tokens (list (list "paren" c))))
(set! i (+ i 1)))
(if
(hl-digit? c)
(let
((start i))
(let
scan
()
(when
(and
(< i len)
(let
((x (substring code i (+ i 1))))
(or (hl-digit? x) (= x "."))))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "number" (substring code start i))))))
(if
(hl-sym-char? c)
(let
((start i))
(let
scan
()
(when
(and
(< i len)
(hl-sym-char? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan)))
(let
((text (substring code start i)))
(if
(or
(= text "true")
(= text "false")
(= text "nil"))
(set!
tokens
(append
tokens
(list (list "boolean" text))))
(if
(sx-special? text)
(set!
tokens
(append
tokens
(list (list "special" text))))
(set!
tokens
(append
tokens
(list (list "symbol" text))))))))
(if
(hl-ws? c)
(let
((start i))
(let
scan
()
(when
(and
(< i len)
(hl-ws? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "ws" (substring code start i))))))
(do
(set!
tokens
(append tokens (list (list "other" c))))
(set! i (+ i 1))))))))))))
(loop)))
tokens)))
(define sx-token-classes {:boolean "text-orange-600" :component "text-rose-600 font-semibold" :number "text-amber-700" :string "text-emerald-700" :special "text-sky-700 font-semibold" :paren "text-stone-400" :keyword "text-violet-600" :comment "text-stone-400 italic"})
(define
render-sx-tokens
(fn
(tokens)
(map
(fn
(tok)
(let
((cls (or (dict-get sx-token-classes (first tok)) "")))
(hl-span cls (nth tok 1))))
tokens)))
(define highlight-sx (fn (code) (render-sx-tokens (tokenize-sx code))))
(define
highlight
(fn
(code lang)
(if
(or (= lang "lisp") (= lang "sx") (= lang "sexp") (= lang "scheme"))
(highlight-sx code)
(list (quote code) code))))

File diff suppressed because it is too large Load Diff

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-86ee6606",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-8ae21d0a",[2,3,5]],["std_exit-10fb8830",[2]],["start-80fdb768",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-80621fb4",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-8ae21d0a",[2,3,5]],["std_exit-10fb8830",[2]],["start-80fdb768",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new

View File

@@ -1,75 +1,130 @@
;; SX docs — documentation page components
(defcomp ~docs/page (&key title &rest children)
(div :class "max-w-4xl mx-auto px-6 pb-8 pt-4"
(defcomp
~docs/page
(&key title &rest children)
(div
:class "max-w-4xl mx-auto px-6 pb-8 pt-4"
(div :class "prose prose-stone max-w-none space-y-6" children)))
(defcomp ~docs/section (&key title id &rest children)
(section :id id :class "space-y-4"
(defcomp
~docs/section
(&key title id &rest children)
(section
:id id
:class "space-y-4"
(h2 :class "text-2xl font-semibold text-stone-800" title)
children))
(defcomp ~docs/subsection (&key title &rest children)
(div :class "space-y-3"
(defcomp
~docs/subsection
(&key title &rest children)
(div
:class "space-y-3"
(h3 :class "text-xl font-semibold text-stone-700" title)
children))
(defcomp ~docs/code (&key src)
(div :class "not-prose bg-stone-100 rounded-lg p-5 mx-auto max-w-3xl"
(pre :class "text-sm leading-relaxed whitespace-pre-wrap break-words font-mono"
(code src))))
(defcomp
~docs/code
(&key src)
(div
:class "not-prose bg-stone-100 rounded-lg p-5 overflow-x-auto my-6"
(pre
:class "text-sm leading-relaxed whitespace-pre-wrap break-words font-mono"
src)))
(defcomp ~docs/note (&key &rest children)
(div :class "border-l-4 border-violet-400 bg-violet-50 p-4 text-stone-700 text-sm"
(defcomp
~docs/note
(&key &rest children)
(div
:class "border-l-4 border-violet-400 bg-violet-50 p-4 text-stone-700 text-sm"
children))
(defcomp ~docs/table (&key headers rows)
(div :class "overflow-x-auto rounded border border-stone-200"
(table :class "w-full text-left text-sm"
(defcomp
~docs/table
(&key headers rows)
(div
:class "overflow-x-auto rounded border border-stone-200"
(table
:class "w-full text-left text-sm"
(thead
(tr :class "border-b border-stone-200 bg-stone-100"
(map (fn (h) (th :class "px-3 py-2 font-medium text-stone-600" h)) headers)))
(tr
:class "border-b border-stone-200 bg-stone-100"
(map
(fn (h) (th :class "px-3 py-2 font-medium text-stone-600" h))
headers)))
(tbody
(map (fn (row)
(tr :class "border-b border-stone-100"
(map (fn (cell) (td :class "px-3 py-2 text-stone-700" cell)) row)))
(map
(fn
(row)
(tr
:class "border-b border-stone-100"
(map
(fn (cell) (td :class "px-3 py-2 text-stone-700" cell))
row)))
rows)))))
(defcomp ~docs/attr-row (&key attr description exists href)
(tr :class "border-b border-stone-100"
(td :class "px-3 py-2 font-mono text-sm whitespace-nowrap"
(if href
(a :href href
:sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
:sx-swap "outerHTML" :sx-push-url "true"
:class "text-violet-700 hover:text-violet-900 underline" attr)
(defcomp
~docs/attr-row
(&key attr description exists href)
(tr
:class "border-b border-stone-100"
(td
:class "px-3 py-2 font-mono text-sm whitespace-nowrap"
(if
href
(a
:href href
:sx-get href
:sx-target "#main-panel"
:sx-select "#main-panel"
:sx-swap "outerHTML"
:sx-push-url "true"
:class "text-violet-700 hover:text-violet-900 underline"
attr)
(span :class "text-violet-700" attr)))
(td :class "px-3 py-2 text-stone-700 text-sm" description)
(td :class "px-3 py-2 text-center"
(if exists
(td
:class "px-3 py-2 text-center"
(if
exists
(span :class "text-emerald-600 text-sm" "yes")
(span :class "text-stone-400 text-sm italic" "not yet")))))
(defcomp ~docs/primitives-table (&key category primitives)
(div :class "space-y-2"
(defcomp
~docs/primitives-table
(&key category primitives)
(div
:class "space-y-2"
(h4 :class "text-lg font-semibold text-stone-700" category)
(div :class "flex flex-wrap gap-2"
(map (fn (p)
(span :class "inline-block px-2 py-1 rounded bg-stone-100 font-mono text-sm text-stone-700" p))
(div
:class "flex flex-wrap gap-2"
(map
(fn
(p)
(span
:class "inline-block px-2 py-1 rounded bg-stone-100 font-mono text-sm text-stone-700"
p))
primitives))))
(defcomp ~docs/nav (&key items current)
(nav :class "flex flex-wrap gap-2 mb-8"
(map (fn (item)
(a :href (nth item 1)
:sx-get (nth item 1)
:sx-target "#main-panel"
:sx-select "#main-panel"
:sx-swap "outerHTML"
:sx-push-url "true"
:class (str "px-3 py-1.5 rounded text-sm font-medium no-underline "
(if (= (nth item 0) current)
"bg-violet-100 text-violet-800"
"bg-stone-100 text-stone-600 hover:bg-stone-200"))
(nth item 0)))
(defcomp
~docs/nav
(&key items current)
(nav
:class "flex flex-wrap gap-2 mb-8"
(map
(fn
(item)
(a
:href (nth item 1)
:sx-get (nth item 1)
:sx-target "#main-panel"
:sx-select "#main-panel"
:sx-swap "outerHTML"
:sx-push-url "true"
:class (str
"px-3 py-1.5 rounded text-sm font-medium no-underline "
(if
(= (nth item 0) current)
"bg-violet-100 text-violet-800"
"bg-stone-100 text-stone-600 hover:bg-stone-200"))
(nth item 0)))
items)))