(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"))
(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 *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
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))))
(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)))))
(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)
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)))))))
(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)))))))
(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)))
(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")))))))))
(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))))
(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)))
(define escape-attr (fn (s) (escape-html s)))