giles
c95e19dcf2
- Add page-helpers-demo page with defisland ~demo-client-runner (pure SX, zero JS files) showing spec functions running on both server and client - Fix _aser_component children serialization: flatten list results from map instead of serialize(list) which wraps in parens creating ((div ...) ...) that re-parses as invalid function call. Fixed in adapter-async.sx spec and async_eval_ref.py - Switch _eval_slot to use async_eval_ref.py when SX_USE_REF=1 (was hardcoded to async_eval.py) - Add Island type support to async_eval_ref.py: import, SSR rendering, aser dispatch, thread-first, defisland in _ASER_FORMS - Add server affinity check: components with :affinity :server expand even when _expand_components is False - Add diagnostic _aser_stack context to EvalError messages - New spec files: adapter-async.sx, page-helpers.sx, platform_js.py - Bootstrappers: page-helpers module support, performance.now() timing - 0-arity lambda event handler fix in adapter-dom.sx Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1199 lines
43 KiB
Plaintext
1199 lines
43 KiB
Plaintext
;; ==========================================================================
|
|
;; adapter-async.sx — Async rendering and serialization adapter
|
|
;;
|
|
;; Async versions of adapter-html.sx (render) and adapter-sx.sx (aser)
|
|
;; for use with I/O-capable server environments (Python async, JS promises).
|
|
;;
|
|
;; Structurally identical to the sync adapters but uses async primitives:
|
|
;; async-eval — evaluate with I/O interception (platform primitive)
|
|
;; async-render — defined here, async HTML rendering
|
|
;; async-aser — defined here, async SX wire format
|
|
;;
|
|
;; All functions in this file are emitted as async by the bootstrapper.
|
|
;; Calls to other async functions receive await automatically.
|
|
;;
|
|
;; Depends on:
|
|
;; eval.sx — cond-scheme?, eval-cond-scheme, eval-cond-clojure,
|
|
;; expand-macro, env-merge, lambda?, component?, island?,
|
|
;; macro?, lambda-closure, lambda-params, lambda-body
|
|
;; render.sx — HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS,
|
|
;; render-attrs, definition-form?, process-bindings, eval-cond
|
|
;;
|
|
;; Platform primitives (provided by host):
|
|
;; (async-eval expr env ctx) — evaluate with I/O interception
|
|
;; (io-primitive? name) — check if name is I/O primitive
|
|
;; (execute-io name args kw ctx) — execute an I/O primitive
|
|
;; (expand-components?) — context var: expand components in aser?
|
|
;; (svg-context?) — context var: in SVG rendering context?
|
|
;; (svg-context-set! val) — set SVG context
|
|
;; (svg-context-reset! token) — reset SVG context
|
|
;; (css-class-collect! val) — collect CSS classes for bundling
|
|
;; (is-raw-html? x) — check if value is raw HTML marker
|
|
;; (raw-html-content x) — extract HTML string from marker
|
|
;; (make-raw-html s) — wrap string as raw HTML
|
|
;; (async-coroutine? x) — check if value is a coroutine
|
|
;; (async-await! x) — await a coroutine value
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Async HTML renderer
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render
|
|
(fn (expr env ctx)
|
|
(case (type-of expr)
|
|
"nil" ""
|
|
"boolean" ""
|
|
"string" (escape-html expr)
|
|
"number" (escape-html (str expr))
|
|
"raw-html" (raw-html-content expr)
|
|
"symbol" (let ((val (async-eval expr env ctx)))
|
|
(async-render val env ctx))
|
|
"keyword" (escape-html (keyword-name expr))
|
|
"list" (if (empty? expr) "" (async-render-list expr env ctx))
|
|
"dict" ""
|
|
:else (escape-html (str expr)))))
|
|
|
|
|
|
(define-async async-render-list
|
|
(fn (expr env ctx)
|
|
(let ((head (first expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
;; Non-symbol head — data list, render each item
|
|
(if (or (lambda? head) (= (type-of head) "list"))
|
|
;; Lambda/list call — eval then render
|
|
(async-render (async-eval expr env ctx) env ctx)
|
|
;; Data list
|
|
(join "" (async-map-render expr env ctx)))
|
|
|
|
;; Symbol head — dispatch
|
|
(let ((name (symbol-name head))
|
|
(args (rest expr)))
|
|
(cond
|
|
;; I/O primitive
|
|
(io-primitive? name)
|
|
(async-render (async-eval expr env ctx) env ctx)
|
|
|
|
;; raw!
|
|
(= name "raw!")
|
|
(async-render-raw args env ctx)
|
|
|
|
;; Fragment
|
|
(= name "<>")
|
|
(join "" (async-map-render args env ctx))
|
|
|
|
;; html: prefix
|
|
(starts-with? name "html:")
|
|
(async-render-element (slice name 5) args env ctx)
|
|
|
|
;; Render-aware special form (but check HTML tag + keyword first)
|
|
(async-render-form? name)
|
|
(if (and (contains? HTML_TAGS name)
|
|
(or (and (> (len expr) 1) (= (type-of (nth expr 1)) "keyword"))
|
|
(svg-context?)))
|
|
(async-render-element name args env ctx)
|
|
(dispatch-async-render-form name expr env ctx))
|
|
|
|
;; Macro
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(async-render
|
|
(trampoline (expand-macro (env-get env name) args env))
|
|
env ctx)
|
|
|
|
;; HTML tag
|
|
(contains? HTML_TAGS name)
|
|
(async-render-element name args env ctx)
|
|
|
|
;; Island (~name)
|
|
(and (starts-with? name "~")
|
|
(env-has? env name)
|
|
(island? (env-get env name)))
|
|
(async-render-island (env-get env name) args env ctx)
|
|
|
|
;; Component (~name)
|
|
(starts-with? name "~")
|
|
(let ((val (if (env-has? env name) (env-get env name) nil)))
|
|
(cond
|
|
(component? val) (async-render-component val args env ctx)
|
|
(macro? val) (async-render (trampoline (expand-macro val args env)) env ctx)
|
|
:else (async-render (async-eval expr env ctx) env ctx)))
|
|
|
|
;; Custom element (has - and keyword arg)
|
|
(and (> (index-of name "-") 0)
|
|
(> (len expr) 1)
|
|
(= (type-of (nth expr 1)) "keyword"))
|
|
(async-render-element name args env ctx)
|
|
|
|
;; SVG context
|
|
(svg-context?)
|
|
(async-render-element name args env ctx)
|
|
|
|
;; Fallback — eval then render
|
|
:else
|
|
(async-render (async-eval expr env ctx) env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-raw — handle (raw! ...) in async context
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-raw
|
|
(fn (args env ctx)
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (arg)
|
|
(let ((val (async-eval arg env ctx)))
|
|
(cond
|
|
(is-raw-html? val) (append! parts (raw-html-content val))
|
|
(= (type-of val) "string") (append! parts val)
|
|
(and (not (nil? val)) (not (= val false)))
|
|
(append! parts (str val)))))
|
|
args)
|
|
(join "" parts))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-element — render an HTML element with async arg evaluation
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-element
|
|
(fn (tag args env ctx)
|
|
(let ((attrs (dict))
|
|
(children (list)))
|
|
;; Parse keyword attrs and children
|
|
(async-parse-element-args args attrs children env ctx)
|
|
;; Collect CSS classes
|
|
(let ((class-val (dict-get attrs "class")))
|
|
(when (and (not (nil? class-val)) (not (= class-val false)))
|
|
(css-class-collect! (str class-val))))
|
|
;; Build opening tag
|
|
(let ((opening (str "<" tag (render-attrs attrs) ">")))
|
|
(if (contains? VOID_ELEMENTS tag)
|
|
opening
|
|
(let ((token (if (or (= tag "svg") (= tag "math"))
|
|
(svg-context-set! true)
|
|
nil))
|
|
(child-html (join "" (async-map-render children env ctx))))
|
|
(when token (svg-context-reset! token))
|
|
(str opening child-html "</" tag ">")))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-parse-element-args — parse :key val pairs + children, async eval
|
|
;; --------------------------------------------------------------------------
|
|
;; Uses for-each + mutable state instead of reduce, because the bootstrapper
|
|
;; compiles inline for-each lambdas as for loops (which can contain await).
|
|
|
|
(define-async async-parse-element-args
|
|
(fn (args attrs children env ctx)
|
|
(let ((skip false)
|
|
(i 0))
|
|
(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 (async-eval (nth args (inc i)) env ctx)))
|
|
(dict-set! attrs (keyword-name arg) val)
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(do
|
|
(append! children arg)
|
|
(set! i (inc i))))))
|
|
args))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-component — expand and render a component asynchronously
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-component
|
|
(fn (comp args env ctx)
|
|
(let ((kwargs (dict))
|
|
(children (list)))
|
|
;; Parse keyword args and children
|
|
(async-parse-kw-args args kwargs children env ctx)
|
|
;; Build env: closure + caller env + params
|
|
(let ((local (env-merge (component-closure comp) env)))
|
|
(for-each
|
|
(fn (p) (env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
|
(component-params comp))
|
|
(when (component-has-children? comp)
|
|
(env-set! local "children"
|
|
(make-raw-html
|
|
(join "" (async-map-render children env ctx)))))
|
|
(async-render (component-body comp) local ctx)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-island — SSR render of reactive island with hydration markers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-island
|
|
(fn (island args env ctx)
|
|
(let ((kwargs (dict))
|
|
(children (list)))
|
|
(async-parse-kw-args args kwargs children env ctx)
|
|
(let ((local (env-merge (component-closure island) env))
|
|
(island-name (component-name island)))
|
|
(for-each
|
|
(fn (p) (env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
|
(component-params island))
|
|
(when (component-has-children? island)
|
|
(env-set! local "children"
|
|
(make-raw-html
|
|
(join "" (async-map-render children env ctx)))))
|
|
(let ((body-html (async-render (component-body island) local ctx))
|
|
(state-json (serialize-island-state kwargs)))
|
|
(str "<span data-sx-island=\"" (escape-attr island-name) "\""
|
|
(if state-json
|
|
(str " data-sx-state=\"" (escape-attr state-json) "\"")
|
|
"")
|
|
">"
|
|
body-html
|
|
"</span>"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-lambda — render lambda body in HTML context
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-lambda
|
|
(fn (f args env ctx)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(for-each-indexed
|
|
(fn (i p) (env-set! local p (nth args i)))
|
|
(lambda-params f))
|
|
(async-render (lambda-body f) local ctx))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-parse-kw-args — parse keyword args and children with async eval
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-parse-kw-args
|
|
(fn (args kwargs children env ctx)
|
|
(let ((skip false)
|
|
(i 0))
|
|
(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 (async-eval (nth args (inc i)) env ctx)))
|
|
(dict-set! kwargs (keyword-name arg) val)
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(do
|
|
(append! children arg)
|
|
(set! i (inc i))))))
|
|
args))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-map-render — map async-render over a list, return list of strings
|
|
;; --------------------------------------------------------------------------
|
|
;; Bootstrapper emits this as: [await async_render(x, env, ctx) for x in exprs]
|
|
|
|
(define-async async-map-render
|
|
(fn (exprs env ctx)
|
|
(let ((results (list)))
|
|
(for-each
|
|
(fn (x) (append! results (async-render x env ctx)))
|
|
exprs)
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Render-aware form classification
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define ASYNC_RENDER_FORMS
|
|
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
|
|
"define" "defcomp" "defisland" "defmacro" "defstyle" "defhandler"
|
|
"map" "map-indexed" "filter" "for-each"))
|
|
|
|
(define async-render-form?
|
|
(fn (name)
|
|
(contains? ASYNC_RENDER_FORMS name)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; dispatch-async-render-form — async special form rendering for HTML output
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Uses cond-scheme? from eval.sx (the FIXED version with every? check)
|
|
;; and eval-cond from render.sx for correct scheme/clojure classification.
|
|
|
|
(define-async dispatch-async-render-form
|
|
(fn (name expr env ctx)
|
|
(cond
|
|
;; if
|
|
(= name "if")
|
|
(let ((cond-val (async-eval (nth expr 1) env ctx)))
|
|
(if cond-val
|
|
(async-render (nth expr 2) env ctx)
|
|
(if (> (len expr) 3)
|
|
(async-render (nth expr 3) env ctx)
|
|
"")))
|
|
|
|
;; when
|
|
(= name "when")
|
|
(if (not (async-eval (nth expr 1) env ctx))
|
|
""
|
|
(join "" (async-map-render (slice expr 2) env ctx)))
|
|
|
|
;; cond — uses cond-scheme? (every? check) from eval.sx
|
|
(= name "cond")
|
|
(let ((clauses (rest expr)))
|
|
(if (cond-scheme? clauses)
|
|
(async-render-cond-scheme clauses env ctx)
|
|
(async-render-cond-clojure clauses env ctx)))
|
|
|
|
;; case
|
|
(= name "case")
|
|
(async-render (async-eval expr env ctx) env ctx)
|
|
|
|
;; let / let*
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (async-process-bindings (nth expr 1) env ctx)))
|
|
(join "" (async-map-render (slice expr 2) local ctx)))
|
|
|
|
;; begin / do
|
|
(or (= name "begin") (= name "do"))
|
|
(join "" (async-map-render (rest expr) env ctx))
|
|
|
|
;; Definition forms
|
|
(definition-form? name)
|
|
(do (async-eval expr env ctx) "")
|
|
|
|
;; map
|
|
(= name "map")
|
|
(let ((f (async-eval (nth expr 1) env ctx))
|
|
(coll (async-eval (nth expr 2) env ctx)))
|
|
(join ""
|
|
(async-map-fn-render f coll env ctx)))
|
|
|
|
;; map-indexed
|
|
(= name "map-indexed")
|
|
(let ((f (async-eval (nth expr 1) env ctx))
|
|
(coll (async-eval (nth expr 2) env ctx)))
|
|
(join ""
|
|
(async-map-indexed-fn-render f coll env ctx)))
|
|
|
|
;; filter — eval fully then render
|
|
(= name "filter")
|
|
(async-render (async-eval expr env ctx) env ctx)
|
|
|
|
;; for-each (render variant)
|
|
(= name "for-each")
|
|
(let ((f (async-eval (nth expr 1) env ctx))
|
|
(coll (async-eval (nth expr 2) env ctx)))
|
|
(join ""
|
|
(async-map-fn-render f coll env ctx)))
|
|
|
|
;; Fallback
|
|
:else
|
|
(async-render (async-eval expr env ctx) env ctx))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-cond-scheme — scheme-style cond for render mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-cond-scheme
|
|
(fn (clauses env ctx)
|
|
(if (empty? clauses)
|
|
""
|
|
(let ((clause (first clauses))
|
|
(test (first clause))
|
|
(body (nth clause 1)))
|
|
(if (or (and (= (type-of test) "symbol")
|
|
(or (= (symbol-name test) "else")
|
|
(= (symbol-name test) ":else")))
|
|
(and (= (type-of test) "keyword")
|
|
(= (keyword-name test) "else")))
|
|
(async-render body env ctx)
|
|
(if (async-eval test env ctx)
|
|
(async-render body env ctx)
|
|
(async-render-cond-scheme (rest clauses) env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-cond-clojure — clojure-style cond for render mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-cond-clojure
|
|
(fn (clauses env ctx)
|
|
(if (< (len clauses) 2)
|
|
""
|
|
(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"))))
|
|
(async-render body env ctx)
|
|
(if (async-eval test env ctx)
|
|
(async-render body env ctx)
|
|
(async-render-cond-clojure (slice clauses 2) env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-process-bindings — evaluate let-bindings asynchronously
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-process-bindings
|
|
(fn (bindings env ctx)
|
|
(let ((local (merge env)))
|
|
(if (and (= (type-of bindings) "list") (not (empty? bindings)))
|
|
(if (= (type-of (first bindings)) "list")
|
|
;; Scheme-style: ((name val) ...)
|
|
(for-each
|
|
(fn (pair)
|
|
(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-set! local name (async-eval (nth pair 1) local ctx)))))
|
|
bindings)
|
|
;; Clojure-style: (name val name val ...)
|
|
(async-process-bindings-flat bindings local ctx)))
|
|
local)))
|
|
|
|
|
|
(define-async async-process-bindings-flat
|
|
(fn (bindings local ctx)
|
|
(let ((skip false)
|
|
(i 0))
|
|
(for-each
|
|
(fn (item)
|
|
(if skip
|
|
(do (set! skip false)
|
|
(set! i (inc i)))
|
|
(do
|
|
(let ((name (if (= (type-of item) "symbol")
|
|
(symbol-name item)
|
|
(str item))))
|
|
(when (< (inc i) (len bindings))
|
|
(env-set! local name
|
|
(async-eval (nth bindings (inc i)) local ctx))))
|
|
(set! skip true)
|
|
(set! i (inc i)))))
|
|
bindings))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-map-fn-render — map a lambda/callable over collection for render
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-map-fn-render
|
|
(fn (f coll env ctx)
|
|
(let ((results (list)))
|
|
(for-each
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(append! results (async-render-lambda f (list item) env ctx))
|
|
(let ((r (async-invoke f item)))
|
|
(append! results (async-render r env ctx)))))
|
|
coll)
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-map-indexed-fn-render — map-indexed variant for render
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-map-indexed-fn-render
|
|
(fn (f coll env ctx)
|
|
(let ((results (list))
|
|
(i 0))
|
|
(for-each
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(append! results (async-render-lambda f (list i item) env ctx))
|
|
(let ((r (async-invoke f i item)))
|
|
(append! results (async-render r env ctx))))
|
|
(set! i (inc i)))
|
|
coll)
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-invoke — call a native callable, await if coroutine
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-invoke
|
|
(fn (f &rest args)
|
|
(let ((r (apply f args)))
|
|
(if (async-coroutine? r)
|
|
(async-await! r)
|
|
r))))
|
|
|
|
|
|
;; ==========================================================================
|
|
;; Async SX wire format (aser)
|
|
;; ==========================================================================
|
|
|
|
(define-async async-aser
|
|
(fn (expr env ctx)
|
|
(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)
|
|
|
|
"dict" (async-aser-dict expr env ctx)
|
|
|
|
"list"
|
|
(if (empty? expr)
|
|
(list)
|
|
(async-aser-list expr env ctx))
|
|
|
|
:else expr)))
|
|
|
|
|
|
(define-async async-aser-dict
|
|
(fn (expr env ctx)
|
|
(let ((result (dict)))
|
|
(for-each
|
|
(fn (key)
|
|
(dict-set! result key (async-aser (dict-get expr key) env ctx)))
|
|
(keys expr))
|
|
result)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-list — dispatch on list head for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-list
|
|
(fn (expr env ctx)
|
|
(let ((head (first expr))
|
|
(args (rest expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
;; Non-symbol head
|
|
(if (or (lambda? head) (= (type-of head) "list"))
|
|
;; Function/list call — eval fully
|
|
(async-aser-eval-call head args env ctx)
|
|
;; Data list — aser each
|
|
(async-aser-map-list expr env ctx))
|
|
|
|
;; Symbol head — dispatch
|
|
(let ((name (symbol-name head)))
|
|
(cond
|
|
;; I/O primitive
|
|
(io-primitive? name)
|
|
(async-eval expr env ctx)
|
|
|
|
;; Fragment
|
|
(= name "<>")
|
|
(async-aser-fragment args env ctx)
|
|
|
|
;; raw!
|
|
(= name "raw!")
|
|
(async-aser-call "raw!" args env ctx)
|
|
|
|
;; html: prefix
|
|
(starts-with? name "html:")
|
|
(async-aser-call (slice name 5) args env ctx)
|
|
|
|
;; Component call (~name)
|
|
(starts-with? name "~")
|
|
(let ((val (if (env-has? env name) (env-get env name) nil)))
|
|
(cond
|
|
(macro? val)
|
|
(async-aser (trampoline (expand-macro val args env)) env ctx)
|
|
(and (component? val)
|
|
(or (expand-components?)
|
|
(= (component-affinity val) "server")))
|
|
(async-aser-component val args env ctx)
|
|
:else
|
|
(async-aser-call name args env ctx)))
|
|
|
|
;; Special/HO forms
|
|
(or (async-aser-form? name))
|
|
(if (and (contains? HTML_TAGS name)
|
|
(or (and (> (len expr) 1) (= (type-of (nth expr 1)) "keyword"))
|
|
(svg-context?)))
|
|
(async-aser-call name args env ctx)
|
|
(dispatch-async-aser-form name expr env ctx))
|
|
|
|
;; HTML tag
|
|
(contains? HTML_TAGS name)
|
|
(async-aser-call name args env ctx)
|
|
|
|
;; Macro
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(async-aser (trampoline (expand-macro (env-get env name) args env)) env ctx)
|
|
|
|
;; Custom element
|
|
(and (> (index-of name "-") 0)
|
|
(> (len expr) 1)
|
|
(= (type-of (nth expr 1)) "keyword"))
|
|
(async-aser-call name args env ctx)
|
|
|
|
;; SVG context
|
|
(svg-context?)
|
|
(async-aser-call name args env ctx)
|
|
|
|
;; Fallback — function/lambda call
|
|
:else
|
|
(async-aser-eval-call head args env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-eval-call — evaluate a function call fully in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-eval-call
|
|
(fn (head args env ctx)
|
|
(let ((f (async-eval head env ctx))
|
|
(evaled-args (async-eval-args args env ctx)))
|
|
(cond
|
|
(and (callable? f) (not (lambda? f)) (not (component? f)))
|
|
(async-invoke f evaled-args)
|
|
(lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(for-each-indexed
|
|
(fn (i p) (env-set! local p (nth evaled-args i)))
|
|
(lambda-params f))
|
|
(async-aser (lambda-body f) local ctx))
|
|
(component? f)
|
|
(async-aser-call (str "~" (component-name f)) args env ctx)
|
|
(island? f)
|
|
(async-aser-call (str "~" (component-name f)) args env ctx)
|
|
:else
|
|
(error (str "Not callable: " (inspect f)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-eval-args — evaluate a list of args asynchronously
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-eval-args
|
|
(fn (args env ctx)
|
|
(let ((results (list)))
|
|
(for-each
|
|
(fn (a) (append! results (async-eval a env ctx)))
|
|
args)
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-map-list — aser each element of a list
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-map-list
|
|
(fn (exprs env ctx)
|
|
(let ((results (list)))
|
|
(for-each
|
|
(fn (x) (append! results (async-aser x env ctx)))
|
|
exprs)
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-fragment — serialize (<> child1 child2 ...) in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-fragment
|
|
(fn (children env ctx)
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (async-aser c env ctx)))
|
|
(if (= (type-of result) "list")
|
|
(for-each
|
|
(fn (item)
|
|
(when (not (nil? item))
|
|
(append! parts (serialize item))))
|
|
result)
|
|
(when (not (nil? result))
|
|
(append! parts (serialize result))))))
|
|
children)
|
|
(if (empty? parts)
|
|
(make-sx-expr "")
|
|
(make-sx-expr (str "(<> " (join " " parts) ")"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-component — expand component server-side in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-component
|
|
(fn (comp args env ctx)
|
|
(let ((kwargs (dict))
|
|
(children (list)))
|
|
(async-parse-aser-kw-args args kwargs children env ctx)
|
|
(let ((local (env-merge (component-closure comp) env)))
|
|
(for-each
|
|
(fn (p) (env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
|
(component-params comp))
|
|
(when (component-has-children? comp)
|
|
(let ((child-parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (async-aser c env ctx)))
|
|
(if (list? result)
|
|
(for-each
|
|
(fn (item)
|
|
(when (not (nil? item))
|
|
(append! child-parts (serialize item))))
|
|
result)
|
|
(when (not (nil? result))
|
|
(append! child-parts (serialize result))))))
|
|
children)
|
|
(env-set! local "children"
|
|
(make-sx-expr (str "(<> " (join " " child-parts) ")")))))
|
|
(async-aser (component-body comp) local ctx)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-parse-aser-kw-args — parse keyword args for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-parse-aser-kw-args
|
|
(fn (args kwargs children env ctx)
|
|
(let ((skip false)
|
|
(i 0))
|
|
(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 (async-aser (nth args (inc i)) env ctx)))
|
|
(dict-set! kwargs (keyword-name arg) val)
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(do
|
|
(append! children arg)
|
|
(set! i (inc i))))))
|
|
args))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-call — serialize an SX call (tag or component) in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-call
|
|
(fn (name args env ctx)
|
|
(let ((token (if (or (= name "svg") (= name "math"))
|
|
(svg-context-set! true)
|
|
nil))
|
|
(parts (list name))
|
|
(skip false)
|
|
(i 0))
|
|
(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 (async-aser (nth args (inc i)) env ctx)))
|
|
(when (not (nil? val))
|
|
(append! parts (str ":" (keyword-name arg)))
|
|
(if (= (type-of val) "list")
|
|
(let ((live (filter (fn (v) (not (nil? v))) val)))
|
|
(if (empty? live)
|
|
(append! parts "nil")
|
|
(let ((items (map serialize live)))
|
|
(if (some (fn (v) (sx-expr? v)) live)
|
|
(append! parts (str "(<> " (join " " items) ")"))
|
|
(append! parts (str "(list " (join " " items) ")"))))))
|
|
(append! parts (serialize val))))
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(let ((result (async-aser arg env ctx)))
|
|
(when (not (nil? result))
|
|
(if (= (type-of result) "list")
|
|
(for-each
|
|
(fn (item)
|
|
(when (not (nil? item))
|
|
(append! parts (serialize item))))
|
|
result)
|
|
(append! parts (serialize result))))
|
|
(set! i (inc i))))))
|
|
args)
|
|
(when token (svg-context-reset! token))
|
|
(make-sx-expr (str "(" (join " " parts) ")")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Aser form classification
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define ASYNC_ASER_FORM_NAMES
|
|
(list "if" "when" "cond" "case" "and" "or"
|
|
"let" "let*" "lambda" "fn"
|
|
"define" "defcomp" "defmacro" "defstyle"
|
|
"defhandler" "defpage" "defquery" "defaction"
|
|
"begin" "do" "quote" "->" "set!" "defisland"))
|
|
|
|
(define ASYNC_ASER_HO_NAMES
|
|
(list "map" "map-indexed" "filter" "for-each"))
|
|
|
|
(define async-aser-form?
|
|
(fn (name)
|
|
(or (contains? ASYNC_ASER_FORM_NAMES name)
|
|
(contains? ASYNC_ASER_HO_NAMES name))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; dispatch-async-aser-form — evaluate special/HO forms in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Uses cond-scheme? from eval.sx (the FIXED version with every? check).
|
|
|
|
(define-async dispatch-async-aser-form
|
|
(fn (name expr env ctx)
|
|
(let ((args (rest expr)))
|
|
(cond
|
|
;; if
|
|
(= name "if")
|
|
(let ((cond-val (async-eval (first args) env ctx)))
|
|
(if cond-val
|
|
(async-aser (nth args 1) env ctx)
|
|
(if (> (len args) 2)
|
|
(async-aser (nth args 2) env ctx)
|
|
nil)))
|
|
|
|
;; when
|
|
(= name "when")
|
|
(if (not (async-eval (first args) env ctx))
|
|
nil
|
|
(let ((result nil))
|
|
(for-each
|
|
(fn (body) (set! result (async-aser body env ctx)))
|
|
(rest args))
|
|
result))
|
|
|
|
;; cond — uses cond-scheme? (every? check)
|
|
(= name "cond")
|
|
(if (cond-scheme? args)
|
|
(async-aser-cond-scheme args env ctx)
|
|
(async-aser-cond-clojure args env ctx))
|
|
|
|
;; case
|
|
(= name "case")
|
|
(let ((match-val (async-eval (first args) env ctx)))
|
|
(async-aser-case-loop match-val (rest args) env ctx))
|
|
|
|
;; let / let*
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (async-process-bindings (first args) env ctx))
|
|
(result nil))
|
|
(for-each
|
|
(fn (body) (set! result (async-aser body local ctx)))
|
|
(rest args))
|
|
result)
|
|
|
|
;; begin / do
|
|
(or (= name "begin") (= name "do"))
|
|
(let ((result nil))
|
|
(for-each
|
|
(fn (body) (set! result (async-aser body env ctx)))
|
|
args)
|
|
result)
|
|
|
|
;; and — short-circuit via flag to avoid 'some' with async lambda
|
|
(= name "and")
|
|
(let ((result true)
|
|
(stop false))
|
|
(for-each (fn (arg)
|
|
(when (not stop)
|
|
(set! result (async-eval arg env ctx))
|
|
(when (not result)
|
|
(set! stop true))))
|
|
args)
|
|
result)
|
|
|
|
;; or — short-circuit via flag to avoid 'some' with async lambda
|
|
(= name "or")
|
|
(let ((result false)
|
|
(stop false))
|
|
(for-each (fn (arg)
|
|
(when (not stop)
|
|
(set! result (async-eval arg env ctx))
|
|
(when result
|
|
(set! stop true))))
|
|
args)
|
|
result)
|
|
|
|
;; lambda / fn
|
|
(or (= name "lambda") (= name "fn"))
|
|
(sf-lambda args env)
|
|
|
|
;; quote
|
|
(= name "quote")
|
|
(if (empty? args) nil (first args))
|
|
|
|
;; -> thread-first
|
|
(= name "->")
|
|
(async-aser-thread-first args env ctx)
|
|
|
|
;; set!
|
|
(= name "set!")
|
|
(let ((value (async-eval (nth args 1) env ctx)))
|
|
(env-set! env (symbol-name (first args)) value)
|
|
value)
|
|
|
|
;; map
|
|
(= name "map")
|
|
(async-aser-ho-map args env ctx)
|
|
|
|
;; map-indexed
|
|
(= name "map-indexed")
|
|
(async-aser-ho-map-indexed args env ctx)
|
|
|
|
;; filter
|
|
(= name "filter")
|
|
(async-eval expr env ctx)
|
|
|
|
;; for-each
|
|
(= name "for-each")
|
|
(async-aser-ho-for-each args env ctx)
|
|
|
|
;; defisland — evaluate AND serialize
|
|
(= name "defisland")
|
|
(do (async-eval expr env ctx)
|
|
(serialize expr))
|
|
|
|
;; Definition forms — evaluate for side effects
|
|
(or (= name "define") (= name "defcomp") (= name "defmacro")
|
|
(= name "defstyle") (= name "defhandler") (= name "defpage")
|
|
(= name "defquery") (= name "defaction"))
|
|
(do (async-eval expr env ctx) nil)
|
|
|
|
;; Fallback
|
|
:else
|
|
(async-eval expr env ctx)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-cond-scheme — scheme-style cond for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-cond-scheme
|
|
(fn (clauses env ctx)
|
|
(if (empty? clauses)
|
|
nil
|
|
(let ((clause (first clauses))
|
|
(test (first clause))
|
|
(body (nth clause 1)))
|
|
(if (or (and (= (type-of test) "symbol")
|
|
(or (= (symbol-name test) "else")
|
|
(= (symbol-name test) ":else")))
|
|
(and (= (type-of test) "keyword")
|
|
(= (keyword-name test) "else")))
|
|
(async-aser body env ctx)
|
|
(if (async-eval test env ctx)
|
|
(async-aser body env ctx)
|
|
(async-aser-cond-scheme (rest clauses) env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-cond-clojure — clojure-style cond for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-cond-clojure
|
|
(fn (clauses env ctx)
|
|
(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"))))
|
|
(async-aser body env ctx)
|
|
(if (async-eval test env ctx)
|
|
(async-aser body env ctx)
|
|
(async-aser-cond-clojure (slice clauses 2) env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-case-loop — case dispatch for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-case-loop
|
|
(fn (match-val clauses env ctx)
|
|
(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"))))
|
|
(async-aser body env ctx)
|
|
(if (= match-val (async-eval test env ctx))
|
|
(async-aser body env ctx)
|
|
(async-aser-case-loop match-val (slice clauses 2) env ctx)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-thread-first — -> form in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-thread-first
|
|
(fn (args env ctx)
|
|
(let ((result (async-eval (first args) env ctx)))
|
|
(for-each
|
|
(fn (form)
|
|
(if (= (type-of form) "list")
|
|
(let ((f (async-eval (first form) env ctx))
|
|
(fn-args (cons result
|
|
(async-eval-args (rest form) env ctx))))
|
|
(set! result (async-invoke-or-lambda f fn-args env ctx)))
|
|
(let ((f (async-eval form env ctx)))
|
|
(set! result (async-invoke-or-lambda f (list result) env ctx)))))
|
|
(rest args))
|
|
result)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-invoke-or-lambda — invoke a callable or lambda with args
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-invoke-or-lambda
|
|
(fn (f args env ctx)
|
|
(cond
|
|
(and (callable? f) (not (lambda? f)) (not (component? f)))
|
|
(let ((r (apply f args)))
|
|
(if (async-coroutine? r)
|
|
(async-await! r)
|
|
r))
|
|
(lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(for-each-indexed
|
|
(fn (i p) (env-set! local p (nth args i)))
|
|
(lambda-params f))
|
|
(async-eval (lambda-body f) local ctx))
|
|
:else
|
|
(error (str "-> form not callable: " (inspect f))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Async aser HO forms (map, map-indexed, for-each)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-ho-map
|
|
(fn (args env ctx)
|
|
(let ((f (async-eval (first args) env ctx))
|
|
(coll (async-eval (nth args 1) env ctx))
|
|
(results (list)))
|
|
(for-each
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-set! local (first (lambda-params f)) item)
|
|
(append! results (async-aser (lambda-body f) local ctx)))
|
|
(append! results (async-invoke f item))))
|
|
coll)
|
|
results)))
|
|
|
|
|
|
(define-async async-aser-ho-map-indexed
|
|
(fn (args env ctx)
|
|
(let ((f (async-eval (first args) env ctx))
|
|
(coll (async-eval (nth args 1) env ctx))
|
|
(results (list))
|
|
(i 0))
|
|
(for-each
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-set! local (first (lambda-params f)) i)
|
|
(env-set! local (nth (lambda-params f) 1) item)
|
|
(append! results (async-aser (lambda-body f) local ctx)))
|
|
(append! results (async-invoke f i item)))
|
|
(set! i (inc i)))
|
|
coll)
|
|
results)))
|
|
|
|
|
|
(define-async async-aser-ho-for-each
|
|
(fn (args env ctx)
|
|
(let ((f (async-eval (first args) env ctx))
|
|
(coll (async-eval (nth args 1) env ctx))
|
|
(results (list)))
|
|
(for-each
|
|
(fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-set! local (first (lambda-params f)) item)
|
|
(append! results (async-aser (lambda-body f) local ctx)))
|
|
(append! results (async-invoke f item))))
|
|
coll)
|
|
results)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — async adapter
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Async evaluation (provided by platform):
|
|
;; (async-eval expr env ctx) — evaluate with I/O interception
|
|
;; (execute-io name args kw ctx) — execute I/O primitive
|
|
;; (io-primitive? name) — check if name is I/O primitive
|
|
;;
|
|
;; From eval.sx:
|
|
;; cond-scheme?, eval-cond-scheme, eval-cond-clojure
|
|
;; eval-expr, trampoline, expand-macro, sf-lambda
|
|
;; env-has?, env-get, env-set!, env-merge
|
|
;; lambda?, component?, island?, macro?, callable?
|
|
;; lambda-closure, lambda-params, lambda-body
|
|
;; component-params, component-body, component-closure,
|
|
;; component-has-children?, component-name
|
|
;; inspect
|
|
;;
|
|
;; From render.sx:
|
|
;; HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS
|
|
;; render-attrs, definition-form?, cond-scheme?
|
|
;; escape-html, escape-attr, raw-html-content
|
|
;;
|
|
;; From adapter-html.sx:
|
|
;; serialize-island-state
|
|
;;
|
|
;; Context management (platform):
|
|
;; (expand-components?) — check if component expansion is enabled
|
|
;; (svg-context?) — check if in SVG context
|
|
;; (svg-context-set! val) — set SVG context (returns reset token)
|
|
;; (svg-context-reset! token) — reset SVG context
|
|
;; (css-class-collect! val) — collect CSS classes
|
|
;;
|
|
;; Raw HTML:
|
|
;; (is-raw-html? x) — check if raw HTML marker
|
|
;; (make-raw-html s) — wrap string as raw HTML
|
|
;; (raw-html-content x) — unwrap raw HTML
|
|
;;
|
|
;; SxExpr:
|
|
;; (make-sx-expr s) — wrap as SxExpr (wire format string)
|
|
;; (sx-expr? x) — check if SxExpr
|
|
;;
|
|
;; Async primitives:
|
|
;; (async-coroutine? x) — check if value is a coroutine
|
|
;; (async-await! x) — await a coroutine
|
|
;; --------------------------------------------------------------------------
|