giles
45c2f2bfb0
parser.sx (3), render.sx (15), harness.sx (21), signals.sx (23), canonical.sx (12) — 74 comments total. Each define now has a ;; comment explaining its purpose. Combined with the evaluator.sx commit, all 215 defines across 6 spec files are now documented. primitives.sx and special-forms.sx already had :doc fields. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
416 lines
8.2 KiB
Plaintext
416 lines
8.2 KiB
Plaintext
;; Registry of all valid HTML tag names
|
|
(define
|
|
HTML_TAGS
|
|
(list
|
|
"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"))
|
|
|
|
;; Self-closing tags (br, img, hr, etc.)
|
|
(define
|
|
VOID_ELEMENTS
|
|
(list
|
|
"area"
|
|
"base"
|
|
"br"
|
|
"col"
|
|
"embed"
|
|
"hr"
|
|
"img"
|
|
"input"
|
|
"link"
|
|
"meta"
|
|
"param"
|
|
"source"
|
|
"track"
|
|
"wbr"))
|
|
|
|
;; Attrs that are true/false (checked, disabled, etc.)
|
|
(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"))
|
|
|
|
;; Extensible list of forms treated as definitions
|
|
(define *definition-form-extensions* (list))
|
|
|
|
;; Check if a symbol names a definition form
|
|
(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))))
|
|
|
|
;; Parse keyword attrs and children from element arg 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
|
|
(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))))
|
|
(dict-set! attrs (keyword-name arg) val)
|
|
(assoc state "skip" true "i" (inc (get state "i"))))
|
|
(do
|
|
(append! children arg)
|
|
(assoc state "i" (inc (get state "i"))))))))
|
|
(dict "i" 0 "skip" false)
|
|
args)
|
|
(list attrs children))))
|
|
|
|
;; Render attr dict to HTML attribute string
|
|
(define
|
|
render-attrs
|
|
:effects ()
|
|
(fn
|
|
((attrs :as dict))
|
|
(join
|
|
""
|
|
(map
|
|
(fn
|
|
((key :as string))
|
|
(let
|
|
((val (dict-get attrs key)))
|
|
(cond
|
|
(and (contains? BOOLEAN_ATTRS key) val)
|
|
(str " " key)
|
|
(and (contains? BOOLEAN_ATTRS key) (not val))
|
|
""
|
|
(nil? val)
|
|
""
|
|
:else (str " " key "=\"" (escape-attr (str val)) "\""))))
|
|
(keys attrs)))))
|
|
|
|
;; Evaluate cond expression (dispatches to scheme/clojure style)
|
|
(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))))
|
|
|
|
;; Scheme-style cond: ((test body) ...)
|
|
(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)
|
|
body
|
|
(if
|
|
(trampoline (eval-expr test env))
|
|
body
|
|
(eval-cond-scheme (rest clauses) env)))))))
|
|
|
|
;; Clojure-style cond: (test body test body ...)
|
|
(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)
|
|
body
|
|
(if
|
|
(trampoline (eval-expr test env))
|
|
body
|
|
(eval-cond-clojure (slice clauses 2) env)))))))
|
|
|
|
;; Evaluate let binding pairs, 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))))))
|
|
bindings)
|
|
local)))
|
|
|
|
;; Check if an expression should be rendered vs evaluated
|
|
(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"))
|
|
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")))))))))
|
|
|
|
;; Merge spread child attrs into parent element attrs
|
|
(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")
|
|
(let
|
|
((existing (dict-get target "class")))
|
|
(dict-set!
|
|
target
|
|
"class"
|
|
(if
|
|
(and existing (not (= existing "")))
|
|
(str existing " " val)
|
|
val)))
|
|
(if
|
|
(= key "style")
|
|
(let
|
|
((existing (dict-get target "style")))
|
|
(dict-set!
|
|
target
|
|
"style"
|
|
(if
|
|
(and existing (not (= existing "")))
|
|
(str existing ";" val)
|
|
val)))
|
|
(dict-set! target key val)))))
|
|
(keys spread-dict))))
|
|
|
|
;; Escape special chars for HTML text content
|
|
(define
|
|
escape-html
|
|
(fn
|
|
(s)
|
|
(let
|
|
((r (str s)))
|
|
(set! r (replace r "&" "&"))
|
|
(set! r (replace r "<" "<"))
|
|
(set! r (replace r ">" ">"))
|
|
(set! r (replace r "\"" """))
|
|
r)))
|
|
|
|
;; Escape special chars for HTML attribute values
|
|
(define escape-attr (fn (s) (escape-html s)))
|