giles
584445a843
Refactor page components (docs, examples, specs, reference, layouts) and adapters (adapter-sx, boot-helpers, orchestration) across sx/ and web/ directories. Add Playwright SPA navigation tests. Rebuild WASM kernel with updated bytecode. Add OCaml primitives for request handling. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
564 lines
17 KiB
Plaintext
564 lines
17 KiB
Plaintext
(define
|
|
render-to-sx
|
|
:effects (render)
|
|
(fn
|
|
(expr (env :as dict))
|
|
(let
|
|
((result (aser expr env)))
|
|
(cond
|
|
(= (type-of result) "sx-expr")
|
|
(sx-expr-source result)
|
|
(= (type-of result) "string")
|
|
result
|
|
:else (serialize result)))))
|
|
|
|
(define
|
|
aser
|
|
:effects (render)
|
|
(fn
|
|
((expr :as any) (env :as dict))
|
|
(set-render-active! true)
|
|
(let
|
|
((result (case (type-of expr) "number" expr "string" expr "boolean" expr "nil" nil "symbol" (let ((name (symbol-name expr))) (cond (env-has? env name) (env-get env name) (primitive? name) (get-primitive name) (= name "true") true (= name "false") false (= name "nil") nil :else (error (str "Undefined symbol: " name)))) "keyword" (keyword-name expr) "list" (if (empty? expr) (list) (aser-list expr env)) "spread" (do (scope-emit! "element-attrs" (spread-attrs expr)) nil) :else expr)))
|
|
(if
|
|
(spread? result)
|
|
(do (scope-emit! "element-attrs" (spread-attrs result)) nil)
|
|
result))))
|
|
|
|
(define
|
|
aser-list
|
|
:effects (render)
|
|
(fn
|
|
((expr :as list) (env :as dict))
|
|
(let
|
|
((head (first expr)) (args (rest expr)))
|
|
(if
|
|
(not (= (type-of head) "symbol"))
|
|
(map (fn (x) (aser x env)) expr)
|
|
(let
|
|
((name (symbol-name head)))
|
|
(cond
|
|
(= name "<>")
|
|
(aser-fragment args env)
|
|
(= name "raw!")
|
|
(aser-call "raw!" args env)
|
|
(starts-with? name "~")
|
|
(let
|
|
((comp (if (env-has? env name) (env-get env name) nil))
|
|
(expand-all
|
|
(if
|
|
(env-has? env "expand-components?")
|
|
(expand-components?)
|
|
false)))
|
|
(cond
|
|
(and comp (macro? comp))
|
|
(aser (expand-macro comp args env) env)
|
|
(and
|
|
comp
|
|
(component? comp)
|
|
(not (island? comp))
|
|
(or expand-all (= (component-affinity comp) "server"))
|
|
(not (= (component-affinity comp) "client")))
|
|
(aser-expand-component comp args env)
|
|
:else (aser-call name args env)))
|
|
(= name "lake")
|
|
(aser-call name args env)
|
|
(= name "marsh")
|
|
(aser-call name args env)
|
|
(= name "error-boundary")
|
|
(aser-call name args env)
|
|
(contains? HTML_TAGS name)
|
|
(aser-call name args env)
|
|
(or (special-form? name) (ho-form? name))
|
|
(aser-special name expr env)
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(aser (expand-macro (env-get env name) args env) env)
|
|
:else (let
|
|
((f (trampoline (eval-expr head env)))
|
|
(evaled-args
|
|
(map (fn (a) (trampoline (eval-expr a env))) args)))
|
|
(cond
|
|
(and
|
|
(callable? f)
|
|
(not (lambda? f))
|
|
(not (component? f))
|
|
(not (island? f)))
|
|
(apply f evaled-args)
|
|
(lambda? f)
|
|
(trampoline (call-lambda f evaled-args env))
|
|
(component? f)
|
|
(aser-call (str "~" (component-name f)) args env)
|
|
(island? f)
|
|
(aser-call (str "~" (component-name f)) args env)
|
|
:else (error (str "Not callable: " (inspect f)))))))))))
|
|
|
|
(define
|
|
aser-reserialize
|
|
:effects ()
|
|
(fn
|
|
(val)
|
|
(if
|
|
(not (= (type-of val) "list"))
|
|
(serialize val)
|
|
(if
|
|
(empty? val)
|
|
"()"
|
|
(let
|
|
((head (first val)))
|
|
(if
|
|
(not (= (type-of head) "symbol"))
|
|
(serialize val)
|
|
(let
|
|
((tag (symbol-name head))
|
|
(parts (list tag))
|
|
(args (rest val))
|
|
(skip false)
|
|
(i 0))
|
|
(for-each
|
|
(fn
|
|
(arg)
|
|
(if
|
|
skip
|
|
(do (set! skip false) (set! i (inc i)))
|
|
(if
|
|
(and
|
|
(= (type-of arg) "string")
|
|
(< (inc i) (len args))
|
|
(not (contains? arg " "))
|
|
(or
|
|
(starts-with? arg "class")
|
|
(starts-with? arg "id")
|
|
(starts-with? arg "sx-")
|
|
(starts-with? arg "data-")
|
|
(starts-with? arg "style")
|
|
(starts-with? arg "href")
|
|
(starts-with? arg "src")
|
|
(starts-with? arg "type")
|
|
(starts-with? arg "name")
|
|
(starts-with? arg "value")
|
|
(starts-with? arg "placeholder")
|
|
(starts-with? arg "action")
|
|
(starts-with? arg "method")
|
|
(starts-with? arg "target")
|
|
(starts-with? arg "role")
|
|
(starts-with? arg "for")
|
|
(starts-with? arg "on")))
|
|
(do
|
|
(append! parts (str ":" arg))
|
|
(append! parts (serialize (nth args (inc i))))
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(do
|
|
(append! parts (aser-reserialize arg))
|
|
(set! i (inc i))))))
|
|
args)
|
|
(str "(" (join " " parts) ")"))))))))
|
|
|
|
(define
|
|
aser-fragment
|
|
:effects (render)
|
|
(fn
|
|
((children :as list) (env :as dict))
|
|
(let
|
|
((parts (list)))
|
|
(for-each
|
|
(fn
|
|
(c)
|
|
(let
|
|
((result (aser c env)))
|
|
(cond
|
|
(nil? result)
|
|
nil
|
|
(= (type-of result) "sx-expr")
|
|
(append! parts (sx-expr-source result))
|
|
(= (type-of result) "list")
|
|
(for-each
|
|
(fn
|
|
(item)
|
|
(when
|
|
(not (nil? item))
|
|
(if
|
|
(= (type-of item) "sx-expr")
|
|
(append! parts (sx-expr-source item))
|
|
(append! parts (aser-reserialize item)))))
|
|
result)
|
|
:else (append! parts (serialize result)))))
|
|
children)
|
|
(if
|
|
(empty? parts)
|
|
""
|
|
(if
|
|
(= (len parts) 1)
|
|
(make-sx-expr (first parts))
|
|
(make-sx-expr (str "(<> " (join " " parts) ")")))))))
|
|
|
|
(define
|
|
aser-call
|
|
:effects (render)
|
|
(fn
|
|
((name :as string) (args :as list) (env :as dict))
|
|
(let
|
|
((attr-parts (list)) (child-parts (list)) (skip false) (i 0))
|
|
(scope-push! "element-attrs" nil)
|
|
(for-each
|
|
(fn
|
|
(arg)
|
|
(if
|
|
skip
|
|
(do (set! skip false) (set! i (inc i)))
|
|
(if
|
|
(and (= (type-of arg) "keyword") (< (inc i) (len args)))
|
|
(let
|
|
((val (aser (nth args (inc i)) env)))
|
|
(when
|
|
(not (nil? val))
|
|
(append! attr-parts (str ":" (keyword-name arg)))
|
|
(if
|
|
(= (type-of val) "sx-expr")
|
|
(append! attr-parts (sx-expr-source val))
|
|
(append! attr-parts (serialize val))))
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(let
|
|
((val (aser arg env)))
|
|
(when
|
|
(not (nil? val))
|
|
(cond
|
|
(= (type-of val) "sx-expr")
|
|
(append! child-parts (sx-expr-source val))
|
|
(= (type-of val) "list")
|
|
(for-each
|
|
(fn
|
|
(item)
|
|
(when
|
|
(not (nil? item))
|
|
(if
|
|
(= (type-of item) "sx-expr")
|
|
(append! child-parts (sx-expr-source item))
|
|
(append! child-parts (serialize item)))))
|
|
val)
|
|
:else (append! child-parts (serialize val))))
|
|
(set! i (inc i))))))
|
|
args)
|
|
(for-each
|
|
(fn
|
|
(spread-dict)
|
|
(for-each
|
|
(fn
|
|
(k)
|
|
(let
|
|
((v (dict-get spread-dict k)))
|
|
(append! attr-parts (str ":" k))
|
|
(append! attr-parts (serialize v))))
|
|
(keys spread-dict)))
|
|
(scope-peek "element-attrs"))
|
|
(scope-pop! "element-attrs")
|
|
(let
|
|
((parts (concat (list name) attr-parts child-parts)))
|
|
(make-sx-expr (str "(" (join " " parts) ")"))))))
|
|
|
|
(define
|
|
aser-expand-component
|
|
:effects (render)
|
|
(fn
|
|
((comp :as any) (args :as list) (env :as dict))
|
|
(let
|
|
((params (component-params comp))
|
|
(local (env-merge env (component-closure comp)))
|
|
(i 0)
|
|
(skip false)
|
|
(children (list)))
|
|
(for-each (fn (p) (env-bind! local p nil)) params)
|
|
(for-each
|
|
(fn
|
|
(arg)
|
|
(if
|
|
skip
|
|
(do (set! skip false) (set! i (inc i)))
|
|
(if
|
|
(and (= (type-of arg) "keyword") (< (inc i) (len args)))
|
|
(do
|
|
(env-bind!
|
|
local
|
|
(keyword-name arg)
|
|
(aser (nth args (inc i)) env))
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(do (append! children arg) (set! i (inc i))))))
|
|
args)
|
|
(when
|
|
(component-has-children comp)
|
|
(let
|
|
((asered-children (map (fn (c) (aser c env)) children)))
|
|
(env-bind!
|
|
local
|
|
"children"
|
|
(if
|
|
(= (len asered-children) 1)
|
|
(first asered-children)
|
|
asered-children))))
|
|
(aser (component-body comp) local))))
|
|
|
|
(define
|
|
SPECIAL_FORM_NAMES
|
|
(list
|
|
"if"
|
|
"when"
|
|
"cond"
|
|
"case"
|
|
"and"
|
|
"or"
|
|
"let"
|
|
"let*"
|
|
"lambda"
|
|
"fn"
|
|
"define"
|
|
"defcomp"
|
|
"defmacro"
|
|
"defstyle"
|
|
"defhandler"
|
|
"defpage"
|
|
"defquery"
|
|
"defaction"
|
|
"defrelation"
|
|
"begin"
|
|
"do"
|
|
"quote"
|
|
"quasiquote"
|
|
"->"
|
|
"set!"
|
|
"letrec"
|
|
"dynamic-wind"
|
|
"defisland"
|
|
"deftype"
|
|
"defeffect"
|
|
"scope"
|
|
"provide"
|
|
"context"
|
|
"emit!"
|
|
"emitted"))
|
|
|
|
(define
|
|
HO_FORM_NAMES
|
|
(list "map" "map-indexed" "filter" "reduce" "some" "every?" "for-each"))
|
|
|
|
(define
|
|
special-form?
|
|
:effects ()
|
|
(fn ((name :as string)) (contains? SPECIAL_FORM_NAMES name)))
|
|
|
|
(define
|
|
ho-form?
|
|
:effects ()
|
|
(fn ((name :as string)) (contains? HO_FORM_NAMES name)))
|
|
|
|
(define
|
|
aser-special
|
|
:effects (render)
|
|
(fn
|
|
((name :as string) (expr :as list) (env :as dict))
|
|
(let
|
|
((args (rest expr)))
|
|
(cond
|
|
(= name "if")
|
|
(if
|
|
(trampoline (eval-expr (first args) env))
|
|
(aser (nth args 1) env)
|
|
(if (> (len args) 2) (aser (nth args 2) env) nil))
|
|
(= name "when")
|
|
(if
|
|
(not (trampoline (eval-expr (first args) env)))
|
|
nil
|
|
(let
|
|
((result nil))
|
|
(for-each
|
|
(fn (body) (set! result (aser body env)))
|
|
(rest args))
|
|
result))
|
|
(= name "cond")
|
|
(let
|
|
((branch (eval-cond args env)))
|
|
(if branch (aser branch env) nil))
|
|
(= name "case")
|
|
(let
|
|
((match-val (trampoline (eval-expr (first args) env)))
|
|
(clauses (rest args)))
|
|
(eval-case-aser match-val clauses env))
|
|
(or (= name "let") (= name "let*"))
|
|
(let
|
|
((local (process-bindings (first args) env)) (result nil))
|
|
(for-each
|
|
(fn (body) (set! result (aser body local)))
|
|
(rest args))
|
|
result)
|
|
(or (= name "begin") (= name "do"))
|
|
(let
|
|
((result nil))
|
|
(for-each (fn (body) (set! result (aser body env))) args)
|
|
result)
|
|
(= name "and")
|
|
(let
|
|
((result true))
|
|
(some
|
|
(fn
|
|
(arg)
|
|
(set! result (trampoline (eval-expr arg env)))
|
|
(not result))
|
|
args)
|
|
result)
|
|
(= name "or")
|
|
(let
|
|
((result false))
|
|
(some
|
|
(fn
|
|
(arg)
|
|
(set! result (trampoline (eval-expr arg env)))
|
|
result)
|
|
args)
|
|
result)
|
|
(= name "map")
|
|
(let
|
|
((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map
|
|
(fn
|
|
(item)
|
|
(if
|
|
(lambda? f)
|
|
(let
|
|
((local (env-merge (lambda-closure f) env)))
|
|
(env-bind! local (first (lambda-params f)) item)
|
|
(aser (lambda-body f) local))
|
|
(cek-call f (list item))))
|
|
coll))
|
|
(= name "map-indexed")
|
|
(let
|
|
((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map-indexed
|
|
(fn
|
|
(i item)
|
|
(if
|
|
(lambda? f)
|
|
(let
|
|
((local (env-merge (lambda-closure f) env)))
|
|
(env-bind! local (first (lambda-params f)) i)
|
|
(env-bind! local (nth (lambda-params f) 1) item)
|
|
(aser (lambda-body f) local))
|
|
(cek-call f (list i item))))
|
|
coll))
|
|
(= name "for-each")
|
|
(let
|
|
((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env)))
|
|
(results (list)))
|
|
(for-each
|
|
(fn
|
|
(item)
|
|
(if
|
|
(lambda? f)
|
|
(let
|
|
((local (env-merge (lambda-closure f) env)))
|
|
(env-bind! local (first (lambda-params f)) item)
|
|
(append! results (aser (lambda-body f) local)))
|
|
(cek-call f (list item))))
|
|
coll)
|
|
(if (empty? results) nil results))
|
|
(= name "defisland")
|
|
(do (trampoline (eval-expr expr env)) (serialize expr))
|
|
(or
|
|
(= name "define")
|
|
(= name "defcomp")
|
|
(= name "defmacro")
|
|
(= name "defstyle")
|
|
(= name "defhandler")
|
|
(= name "defpage")
|
|
(= name "defquery")
|
|
(= name "defaction")
|
|
(= name "defrelation")
|
|
(= name "deftype")
|
|
(= name "defeffect"))
|
|
(do (trampoline (eval-expr expr env)) nil)
|
|
(= name "scope")
|
|
(let
|
|
((scope-name (trampoline (eval-expr (first args) env)))
|
|
(rest-args (rest args))
|
|
(scope-val nil)
|
|
(body-args nil))
|
|
(if
|
|
(and
|
|
(>= (len rest-args) 2)
|
|
(= (type-of (first rest-args)) "keyword")
|
|
(= (keyword-name (first rest-args)) "value"))
|
|
(do
|
|
(set!
|
|
scope-val
|
|
(trampoline (eval-expr (nth rest-args 1) env)))
|
|
(set! body-args (slice rest-args 2)))
|
|
(set! body-args rest-args))
|
|
(scope-push! scope-name scope-val)
|
|
(let
|
|
((result nil))
|
|
(for-each (fn (body) (set! result (aser body env))) body-args)
|
|
(scope-pop! scope-name)
|
|
result))
|
|
(= name "provide")
|
|
(let
|
|
((prov-name (trampoline (eval-expr (first args) env)))
|
|
(prov-val (trampoline (eval-expr (nth args 1) env)))
|
|
(result nil))
|
|
(scope-push! prov-name prov-val)
|
|
(for-each
|
|
(fn (body) (set! result (aser body env)))
|
|
(slice args 2))
|
|
(scope-pop! prov-name)
|
|
result)
|
|
(= name "context")
|
|
(let
|
|
((ctx-name (trampoline (eval-expr (first args) env)))
|
|
(default-val
|
|
(if
|
|
(>= (len args) 2)
|
|
(trampoline (eval-expr (nth args 1) env))
|
|
nil)))
|
|
(let
|
|
((val (scope-peek ctx-name)))
|
|
(if (nil? val) default-val val)))
|
|
(= name "emit!")
|
|
(let
|
|
((emit-name (trampoline (eval-expr (first args) env)))
|
|
(emit-val (trampoline (eval-expr (nth args 1) env))))
|
|
(scope-emit! emit-name emit-val)
|
|
nil)
|
|
(= name "emitted")
|
|
(let
|
|
((emit-name (trampoline (eval-expr (first args) env))))
|
|
(or (scope-peek emit-name) (list)))
|
|
:else (trampoline (eval-expr expr env))))))
|
|
|
|
(define
|
|
eval-case-aser
|
|
:effects (render)
|
|
(fn
|
|
(match-val (clauses :as list) (env :as dict))
|
|
(if
|
|
(< (len clauses) 2)
|
|
nil
|
|
(let
|
|
((test (first clauses)) (body (nth clauses 1)))
|
|
(if
|
|
(or
|
|
(and
|
|
(= (type-of test) "keyword")
|
|
(= (keyword-name test) "else"))
|
|
(and
|
|
(= (type-of test) "symbol")
|
|
(or
|
|
(= (symbol-name test) ":else")
|
|
(= (symbol-name test) "else"))))
|
|
(aser body env)
|
|
(if
|
|
(= match-val (trampoline (eval-expr test env)))
|
|
(aser body env)
|
|
(eval-case-aser match-val (slice clauses 2) env)))))))
|