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

SX renderer: adapter-html.sx as sole renderer, conditions, pattern matching

Browse Source 
Evaluator: conditions/restarts, pattern matching, render-trace support.
adapter-html.sx: full SX-defined HTML renderer replacing native OCaml.
spec/render.sx: updated render mode helpers.
sx_browser.ml: use SX render-to-html instead of native.
sx_ref.ml: evaluator updates for conditions + match.
Bootstrap + transpiler updates for new forms.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 01:28:53 +00:00
parent 015781313c
commit e1ef883339
15 changed files with 3460 additions and 2320 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4082
spec/evaluator.sx
View File

File diff suppressed because it is too large Load Diff

579
spec/render.sx
View File

@@ -1,101 +1,229 @@
;; ==========================================================================
;; render.sx — Core rendering specification
;;
;; Shared registries and utilities used by all rendering adapters.
;; This file defines WHAT is renderable (tag registries, attribute rules)
;; and HOW arguments are parsed — but not the output format.
;;
;; Adapters:
;; adapter-html.sx — HTML string output (server)
;; adapter-sx.sx — SX wire format output (server → client)
;; adapter-dom.sx — Live DOM node output (browser)
;;
;; Each adapter imports these shared definitions and provides its own
;; render entry point (render-to-html, render-to-sx, render-to-dom).
;; ==========================================================================
;; --------------------------------------------------------------------------
;; HTML tag registry
;; --------------------------------------------------------------------------
;; Tags known to the renderer. Unknown names are treated as function calls.
;; Void elements self-close (no children). Boolean attrs emit name only.
(define HTML_TAGS
(define
HTML_TAGS
(list
;; Document
"html" "head" "body" "title" "meta" "link" "script" "style" "noscript"
;; Sections
"header" "nav" "main" "section" "article" "aside" "footer"
"h1" "h2" "h3" "h4" "h5" "h6" "hgroup"
;; Block
"div" "p" "blockquote" "pre" "figure" "figcaption" "address" "details" "summary"
;; Inline
"a" "span" "em" "strong" "small" "b" "i" "u" "s" "mark" "sub" "sup"
"abbr" "cite" "code" "kbd" "samp" "var" "time" "br" "wbr" "hr"
;; Lists
"ul" "ol" "li" "dl" "dt" "dd"
;; Tables
"table" "thead" "tbody" "tfoot" "tr" "th" "td" "caption" "colgroup" "col"
;; Forms
"form" "input" "textarea" "select" "option" "optgroup" "button" "label"
"fieldset" "legend" "output" "datalist"
;; Media
"img" "video" "audio" "source" "picture" "canvas" "iframe"
;; SVG
"svg" "math" "path" "circle" "ellipse" "rect" "line" "polyline" "polygon"
"text" "tspan" "g" "defs" "use" "clipPath" "mask" "pattern"
"linearGradient" "radialGradient" "stop" "filter"
"feGaussianBlur" "feOffset" "feBlend" "feColorMatrix" "feComposite"
"feMerge" "feMergeNode" "feTurbulence"
"feComponentTransfer" "feFuncR" "feFuncG" "feFuncB" "feFuncA"
"feDisplacementMap" "feFlood" "feImage" "feMorphology"
"feSpecularLighting" "feDiffuseLighting"
"fePointLight" "feSpotLight" "feDistantLight"
"animate" "animateTransform" "foreignObject"
;; Other
"template" "slot" "dialog" "menu"))
"html"
"head"
"body"
"title"
"meta"
"link"
"script"
"style"
"noscript"
"header"
"nav"
"main"
"section"
"article"
"aside"
"footer"
"h1"
"h2"
"h3"
"h4"
"h5"
"h6"
"hgroup"
"div"
"p"
"blockquote"
"pre"
"figure"
"figcaption"
"address"
"details"
"summary"
"a"
"span"
"em"
"strong"
"small"
"b"
"i"
"u"
"s"
"mark"
"sub"
"sup"
"abbr"
"cite"
"code"
"kbd"
"samp"
"var"
"time"
"br"
"wbr"
"hr"
"ul"
"ol"
"li"
"dl"
"dt"
"dd"
"table"
"thead"
"tbody"
"tfoot"
"tr"
"th"
"td"
"caption"
"colgroup"
"col"
"form"
"input"
"textarea"
"select"
"option"
"optgroup"
"button"
"label"
"fieldset"
"legend"
"output"
"datalist"
"img"
"video"
"audio"
"source"
"picture"
"canvas"
"iframe"
"svg"
"math"
"path"
"circle"
"ellipse"
"rect"
"line"
"polyline"
"polygon"
"text"
"tspan"
"g"
"defs"
"use"
"clipPath"
"mask"
"pattern"
"linearGradient"
"radialGradient"
"stop"
"filter"
"feGaussianBlur"
"feOffset"
"feBlend"
"feColorMatrix"
"feComposite"
"feMerge"
"feMergeNode"
"feTurbulence"
"feComponentTransfer"
"feFuncR"
"feFuncG"
"feFuncB"
"feFuncA"
"feDisplacementMap"
"feFlood"
"feImage"
"feMorphology"
"feSpecularLighting"
"feDiffuseLighting"
"fePointLight"
"feSpotLight"
"feDistantLight"
"animate"
"animateTransform"
"foreignObject"
"template"
"slot"
"dialog"
"menu"))
(define VOID_ELEMENTS
(list "area" "base" "br" "col" "embed" "hr" "img" "input"
"link" "meta" "param" "source" "track" "wbr"))
(define
VOID_ELEMENTS
(list
"area"
"base"
"br"
"col"
"embed"
"hr"
"img"
"input"
"link"
"meta"
"param"
"source"
"track"
"wbr"))
(define BOOLEAN_ATTRS
(list "async" "autofocus" "autoplay" "checked" "controls" "default"
"defer" "disabled" "formnovalidate" "hidden" "inert" "ismap"
"loop" "multiple" "muted" "nomodule" "novalidate" "open"
"playsinline" "readonly" "required" "reversed" "selected"))
(define
BOOLEAN_ATTRS
(list
"async"
"autofocus"
"autoplay"
"checked"
"controls"
"default"
"defer"
"disabled"
"formnovalidate"
"hidden"
"inert"
"ismap"
"loop"
"multiple"
"muted"
"nomodule"
"novalidate"
"open"
"playsinline"
"readonly"
"required"
"reversed"
"selected"))
;; --------------------------------------------------------------------------
;; Shared utilities
;; --------------------------------------------------------------------------
;; Extension point for definition forms — modules append names here.
;; Survives spec reloads (no function wrapping needed).
(define *definition-form-extensions* (list))
(define definition-form? :effects []
(fn ((name :as string))
(or (= name "define") (= name "defcomp") (= name "defisland")
(= name "defmacro") (= name "defstyle")
(= name "deftype") (= name "defeffect")
(contains? *definition-form-extensions* name))))
(define
definition-form?
:effects ()
(fn
((name :as string))
(or
(= name "define")
(= name "defcomp")
(= name "defisland")
(= name "defmacro")
(= name "defstyle")
(= name "deftype")
(= name "defeffect")
(contains? *definition-form-extensions* name))))
(define parse-element-args :effects [render]
(fn ((args :as list) (env :as dict))
;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list)
(let ((attrs (dict))
(children (list)))
(define
parse-element-args
:effects (render)
(fn
((args :as list) (env :as dict))
(let
((attrs (dict)) (children (list)))
(reduce
(fn ((state :as dict) arg)
(let ((skip (get state "skip")))
(if skip
(fn
((state :as dict) arg)
(let
((skip (get state "skip")))
(if
skip
(assoc state "skip" false "i" (inc (get state "i")))
(if (and (= (type-of arg) "keyword")
(< (inc (get state "i")) (len args)))
(let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
(if
(and
(= (type-of arg) "keyword")
(< (inc (get state "i")) (len args)))
(let
((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
(dict-set! attrs (keyword-name arg) val)
(assoc state "skip" true "i" (inc (get state "i"))))
(do
@@ -105,193 +233,168 @@
args)
(list attrs children))))
(define render-attrs :effects []
(fn ((attrs :as dict))
;; Render an attrs dict to an HTML attribute string.
;; Used by adapter-html.sx and adapter-sx.sx.
(join ""
(define
render-attrs
:effects ()
(fn
((attrs :as dict))
(join
""
(map
(fn ((key :as string))
(let ((val (dict-get attrs key)))
(fn
((key :as string))
(let
((val (dict-get attrs key)))
(cond
;; Boolean attrs
(and (contains? BOOLEAN_ATTRS key) val)
(str " " key)
(str " " key)
(and (contains? BOOLEAN_ATTRS key) (not val))
""
;; Nil values — skip
(nil? val) ""
;; Normal attr
""
(nil? val)
""
:else (str " " key "=\"" (escape-attr (str val)) "\""))))
(keys attrs)))))
;; --------------------------------------------------------------------------
;; Render adapter helpers
;; --------------------------------------------------------------------------
;; Shared by HTML and DOM adapters for evaluating control forms during
;; rendering. Unlike sf-cond (eval.sx) which returns a thunk for TCO,
;; eval-cond returns the unevaluated body expression so the adapter
;; can render it in its own mode (HTML string vs DOM nodes).
;; eval-cond: find matching cond branch, return unevaluated body expr.
;; Handles both scheme-style ((test body) ...) and clojure-style
;; (test body test body ...).
(define eval-cond :effects []
(fn ((clauses :as list) (env :as dict))
(if (cond-scheme? clauses)
(define
eval-cond
:effects ()
(fn
((clauses :as list) (env :as dict))
(if
(cond-scheme? clauses)
(eval-cond-scheme clauses env)
(eval-cond-clojure clauses env))))
(define eval-cond-scheme :effects []
(fn ((clauses :as list) (env :as dict))
(if (empty? clauses)
(define
eval-cond-scheme
:effects ()
(fn
((clauses :as list) (env :as dict))
(if
(empty? clauses)
nil
(let ((clause (first clauses))
(test (first clause))
(body (nth clause 1)))
(if (is-else-clause? test)
(let
((clause (first clauses))
(test (first clause))
(body (nth clause 1)))
(if
(is-else-clause? test)
body
(if (trampoline (eval-expr test env))
(if
(trampoline (eval-expr test env))
body
(eval-cond-scheme (rest clauses) env)))))))
(define eval-cond-clojure :effects []
(fn ((clauses :as list) (env :as dict))
(if (< (len clauses) 2)
(define
eval-cond-clojure
:effects ()
(fn
((clauses :as list) (env :as dict))
(if
(< (len clauses) 2)
nil
(let ((test (first clauses))
(body (nth clauses 1)))
(if (is-else-clause? test)
(let
((test (first clauses)) (body (nth clauses 1)))
(if
(is-else-clause? test)
body
(if (trampoline (eval-expr test env))
(if
(trampoline (eval-expr test env))
body
(eval-cond-clojure (slice clauses 2) env)))))))
;; process-bindings: evaluate let-binding pairs, return extended env.
;; bindings = ((name1 expr1) (name2 expr2) ...)
(define process-bindings :effects [mutation]
(fn ((bindings :as list) (env :as dict))
;; env-extend (not merge) — Env is not a dict subclass, so merge()
;; returns an empty dict, losing all parent scope bindings.
(let ((local (env-extend env)))
(define
process-bindings
:effects (mutation)
(fn
((bindings :as list) (env :as dict))
(let
((local (env-extend env)))
(for-each
(fn ((pair :as list))
(when (and (= (type-of pair) "list") (>= (len pair) 2))
(let ((name (if (= (type-of (first pair)) "symbol")
(symbol-name (first pair))
(str (first pair)))))
(env-bind! local name (trampoline (eval-expr (nth pair 1) local))))))
(fn
((pair :as list))
(when
(and (= (type-of pair) "list") (>= (len pair) 2))
(let
((name (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
(env-bind!
local
name
(trampoline (eval-expr (nth pair 1) local))))))
bindings)
local)))
;; --------------------------------------------------------------------------
;; is-render-expr? — check if expression is a rendering form
;; --------------------------------------------------------------------------
;; Used by eval-list to dispatch rendering forms to the active adapter
;; (HTML, SX wire, or DOM) rather than evaluating them as function calls.
(define is-render-expr? :effects []
(fn (expr)
(if (or (not (= (type-of expr) "list")) (empty? expr))
(define
is-render-expr?
:effects ()
(fn
(expr)
(if
(or (not (= (type-of expr) "list")) (empty? expr))
false
(let ((h (first expr)))
(if (not (= (type-of h) "symbol"))
(let
((h (first expr)))
(if
(not (= (type-of h) "symbol"))
false
(let ((n (symbol-name h)))
(or (= n "<>")
(= n "raw!")
(starts-with? n "~")
(starts-with? n "html:")
(contains? HTML_TAGS n)
(and (> (index-of n "-") 0)
(> (len expr) 1)
(= (type-of (nth expr 1)) "keyword")))))))))
(let
((n (symbol-name h)))
(or
(= n "<>")
(= n "raw!")
(starts-with? n "~")
(starts-with? n "html:")
(contains? HTML_TAGS n)
(and
(> (index-of n "-") 0)
(> (len expr) 1)
(= (type-of (nth expr 1)) "keyword")))))))))
;; --------------------------------------------------------------------------
;; Spread — attribute injection from children into parent elements
;; --------------------------------------------------------------------------
;;
;; A spread value is a dict of attributes that, when returned as a child
;; of an HTML element, merges its attrs onto the parent element.
;; This enables components to inject classes/styles/data-attrs onto their
;; parent without the parent knowing about the specific attrs.
;;
;; merge-spread-attrs: merge a spread's attrs into an element's attrs dict.
;; Class values are joined (space-separated); others overwrite.
;; Mutates the target attrs dict in place.
(define merge-spread-attrs :effects [mutation]
(fn ((target :as dict) (spread-dict :as dict))
(define
merge-spread-attrs
:effects (mutation)
(fn
((target :as dict) (spread-dict :as dict))
(for-each
(fn ((key :as string))
(let ((val (dict-get spread-dict key)))
(if (= key "class")
;; Class: join existing + new with space
(let ((existing (dict-get target "class")))
(dict-set! target "class"
(if (and existing (not (= existing "")))
(fn
((key :as string))
(let
((val (dict-get spread-dict key)))
(if
(= key "class")
(let
((existing (dict-get target "class")))
(dict-set!
target
"class"
(if
(and existing (not (= existing "")))
(str existing " " val)
val)))
;; Style: join with semicolons
(if (= key "style")
(let ((existing (dict-get target "style")))
(dict-set! target "style"
(if (and existing (not (= existing "")))
(if
(= key "style")
(let
((existing (dict-get target "style")))
(dict-set!
target
"style"
(if
(and existing (not (= existing "")))
(str existing ";" val)
val)))
;; Everything else: overwrite
(dict-set! target key val)))))
(keys spread-dict))))
;; --------------------------------------------------------------------------
;; HTML escaping — library functions (pure text processing)
;; --------------------------------------------------------------------------
(define escape-html
(fn (s)
(let ((r (str s)))
(define
escape-html
(fn
(s)
(let
((r (str s)))
(set! r (replace r "&" "&amp;"))
(set! r (replace r "<" "&lt;"))
(set! r (replace r ">" "&gt;"))
(set! r (replace r "\"" "&quot;"))
r)))
(define escape-attr
(fn (s)
(escape-html s)))
;; --------------------------------------------------------------------------
;; Platform interface (shared across adapters)
;; --------------------------------------------------------------------------
;;
;; Raw HTML (marker type for unescaped content):
;; (raw-html-content r) → unwrap RawHTML marker to string
;;
;; Spread (render-time attribute injection):
;; (make-spread attrs) → Spread value
;; (spread? x) → boolean
;; (spread-attrs s) → dict
;;
;; Render-time accumulators:
;; (collect! bucket value) → void
;; (collected bucket) → list
;; (clear-collected! bucket) → void
;;
;; Scoped effects (scope/provide/context/emit!):
;; (scope-push! name val) → void (general form)
;; (scope-pop! name) → void (general form)
;; (provide-push! name val) → alias for scope-push!
;; (provide-pop! name) → alias for scope-pop!
;; (context name &rest def) → value from nearest scope
;; (emit! name value) → void (append to scope accumulator)
;; (emitted name) → list of emitted values
;;
;; From parser.sx:
;; (sx-serialize val) → SX source string (aliased as serialize above)
;; --------------------------------------------------------------------------
(define escape-attr (fn (s) (escape-html s)))