giles
ea2b71cfa3
Four new primitives for scoped downward value passing and upward accumulation through the render tree. Specced in .sx, bootstrapped to Python and JS across all adapters (eval, html, sx, dom, async). Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1338 lines
51 KiB
Plaintext
1338 lines
51 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 :effects [render io]
|
|
(fn (expr (env :as dict) ctx)
|
|
(case (type-of expr)
|
|
"nil" ""
|
|
"boolean" ""
|
|
"string" (escape-html expr)
|
|
"number" (escape-html (str expr))
|
|
"raw-html" (raw-html-content expr)
|
|
"spread" 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 :effects [render io]
|
|
(fn (expr (env :as dict) 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 (spreads filtered — no parent element)
|
|
(= name "<>")
|
|
(join "" (filter (fn (r) (not (spread? r)))
|
|
(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 :effects [render io]
|
|
(fn ((args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((tag :as string) (args :as list) (env :as dict) 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))))
|
|
(if (contains? VOID_ELEMENTS tag)
|
|
(str "<" tag (render-attrs attrs) ">")
|
|
;; Render children, collecting spreads and content separately
|
|
(let ((token (if (or (= tag "svg") (= tag "math"))
|
|
(svg-context-set! true)
|
|
nil))
|
|
(content-parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (async-render c env ctx)))
|
|
(if (spread? result)
|
|
(merge-spread-attrs attrs (spread-attrs result))
|
|
(append! content-parts result))))
|
|
children)
|
|
(when token (svg-context-reset! token))
|
|
(str "<" tag (render-attrs attrs) ">"
|
|
(join "" content-parts)
|
|
"</" 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 :effects [render io]
|
|
(fn ((args :as list) (attrs :as dict) (children :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((comp :as component) (args :as list) (env :as dict) 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))
|
|
;; Pre-render children to raw HTML (filter spreads — no parent element)
|
|
(when (component-has-children? comp)
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((r (async-render c env ctx)))
|
|
(when (not (spread? r))
|
|
(append! parts r))))
|
|
children)
|
|
(env-set! local "children"
|
|
(make-raw-html (join "" parts)))))
|
|
(async-render (component-body comp) local ctx)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-render-island — SSR render of reactive island with hydration markers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-render-island :effects [render io]
|
|
(fn ((island :as island) (args :as list) (env :as dict) 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))
|
|
;; Pre-render children (filter spreads — no parent element)
|
|
(when (component-has-children? island)
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((r (async-render c env ctx)))
|
|
(when (not (spread? r))
|
|
(append! parts r))))
|
|
children)
|
|
(env-set! local "children"
|
|
(make-raw-html (join "" parts)))))
|
|
(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 :effects [render io]
|
|
(fn ((f :as lambda) (args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((args :as list) (kwargs :as dict) (children :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((exprs :as list) (env :as dict) 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"
|
|
"deftype" "defeffect"
|
|
"map" "map-indexed" "filter" "for-each" "provide"))
|
|
|
|
(define async-render-form? :effects []
|
|
(fn ((name :as string))
|
|
(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 :effects [render io]
|
|
(fn ((name :as string) expr (env :as dict) 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 — single body: pass through (spread propagates). Multi: join strings.
|
|
(= name "when")
|
|
(if (not (async-eval (nth expr 1) env ctx))
|
|
""
|
|
(if (= (len expr) 3)
|
|
(async-render (nth expr 2) env ctx)
|
|
(let ((results (async-map-render (slice expr 2) env ctx)))
|
|
(join "" (filter (fn (r) (not (spread? r))) results)))))
|
|
|
|
;; 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* — single body: pass through. Multi: join strings.
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (async-process-bindings (nth expr 1) env ctx)))
|
|
(if (= (len expr) 3)
|
|
(async-render (nth expr 2) local ctx)
|
|
(let ((results (async-map-render (slice expr 2) local ctx)))
|
|
(join "" (filter (fn (r) (not (spread? r))) results)))))
|
|
|
|
;; begin / do — single body: pass through. Multi: join strings.
|
|
(or (= name "begin") (= name "do"))
|
|
(if (= (len expr) 2)
|
|
(async-render (nth expr 1) env ctx)
|
|
(let ((results (async-map-render (rest expr) env ctx)))
|
|
(join "" (filter (fn (r) (not (spread? r))) results))))
|
|
|
|
;; Definition forms
|
|
(definition-form? name)
|
|
(do (async-eval expr env ctx) "")
|
|
|
|
;; map — spreads filtered
|
|
(= name "map")
|
|
(let ((f (async-eval (nth expr 1) env ctx))
|
|
(coll (async-eval (nth expr 2) env ctx)))
|
|
(join ""
|
|
(filter (fn (r) (not (spread? r)))
|
|
(async-map-fn-render f coll env ctx))))
|
|
|
|
;; map-indexed — spreads filtered
|
|
(= name "map-indexed")
|
|
(let ((f (async-eval (nth expr 1) env ctx))
|
|
(coll (async-eval (nth expr 2) env ctx)))
|
|
(join ""
|
|
(filter (fn (r) (not (spread? r)))
|
|
(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) — spreads filtered
|
|
(= name "for-each")
|
|
(let ((f (async-eval (nth expr 1) env ctx))
|
|
(coll (async-eval (nth expr 2) env ctx)))
|
|
(join ""
|
|
(filter (fn (r) (not (spread? r)))
|
|
(async-map-fn-render f coll env ctx))))
|
|
|
|
;; provide — render-time dynamic scope
|
|
(= name "provide")
|
|
(let ((prov-name (async-eval (nth expr 1) env ctx))
|
|
(prov-val (async-eval (nth expr 2) env ctx))
|
|
(body-start 3)
|
|
(body-count (- (len expr) 3)))
|
|
(provide-push! prov-name prov-val)
|
|
(let ((result (if (= body-count 1)
|
|
(async-render (nth expr body-start) env ctx)
|
|
(let ((results (async-map-render (slice expr body-start) env ctx)))
|
|
(join "" (filter (fn (r) (not (spread? r))) results))))))
|
|
(provide-pop! prov-name)
|
|
result))
|
|
|
|
;; 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 :effects [render io]
|
|
(fn ((clauses :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((clauses :as list) (env :as dict) 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 :effects [render io]
|
|
(fn (bindings (env :as dict) ctx)
|
|
;; 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)))
|
|
(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 :effects [render io]
|
|
(fn ((bindings :as list) (local :as dict) 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 :effects [render io]
|
|
(fn (f (coll :as list) (env :as dict) 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 :effects [render io]
|
|
(fn (f (coll :as list) (env :as dict) 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 :effects [io]
|
|
(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 :effects [render io]
|
|
(fn (expr (env :as dict) 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)
|
|
|
|
;; Spread — pass through for client rendering
|
|
"spread" expr
|
|
|
|
"list"
|
|
(if (empty? expr)
|
|
(list)
|
|
(async-aser-list expr env ctx))
|
|
|
|
:else expr)))
|
|
|
|
|
|
(define-async async-aser-dict :effects [render io]
|
|
(fn ((expr :as dict) (env :as dict) 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 :effects [render io]
|
|
(fn (expr (env :as dict) 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 :effects [render io]
|
|
(fn (head (args :as list) (env :as dict) 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)))
|
|
;; apply directly — async-invoke takes &rest so passing a list
|
|
;; would wrap it in another list
|
|
(let ((r (apply f evaled-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 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 :effects [io]
|
|
(fn ((args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((exprs :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((children :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((comp :as component) (args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((args :as list) (kwargs :as dict) (children :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((name :as string) (args :as list) (env :as dict) 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"
|
|
"deftype" "defeffect" "provide"))
|
|
|
|
(define ASYNC_ASER_HO_NAMES
|
|
(list "map" "map-indexed" "filter" "for-each"))
|
|
|
|
(define async-aser-form? :effects []
|
|
(fn ((name :as string))
|
|
(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 :effects [render io]
|
|
(fn ((name :as string) expr (env :as dict) 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")
|
|
(= name "deftype") (= name "defeffect"))
|
|
(do (async-eval expr env ctx) nil)
|
|
|
|
;; provide — render-time dynamic scope
|
|
(= name "provide")
|
|
(let ((prov-name (async-eval (first args) env ctx))
|
|
(prov-val (async-eval (nth args 1) env ctx))
|
|
(result nil))
|
|
(provide-push! prov-name prov-val)
|
|
(for-each (fn (body) (set! result (async-aser body env ctx)))
|
|
(slice args 2))
|
|
(provide-pop! prov-name)
|
|
result)
|
|
|
|
;; Fallback
|
|
:else
|
|
(async-eval expr env ctx)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-aser-cond-scheme — scheme-style cond for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define-async async-aser-cond-scheme :effects [render io]
|
|
(fn ((clauses :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((clauses :as list) (env :as dict) 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 :effects [render io]
|
|
(fn (match-val (clauses :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn (f (args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((args :as list) (env :as dict) 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 :effects [render io]
|
|
(fn ((args :as list) (env :as dict) 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)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; async-eval-slot-inner — server-side slot expansion for aser mode
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Coordinates component expansion for server-rendered pages:
|
|
;; 1. If expression is a direct component call (~name ...), expand it
|
|
;; 2. Otherwise aser the expression, then check if result is a (~...)
|
|
;; call that should be re-expanded
|
|
;;
|
|
;; Platform primitives required:
|
|
;; (sx-parse src) — parse SX source string
|
|
;; (make-sx-expr s) — wrap as SxExpr
|
|
;; (sx-expr? x) — check if SxExpr
|
|
;; (set-expand-components!) — enable component expansion context var
|
|
|
|
(define-async async-eval-slot-inner :effects [render io]
|
|
(fn (expr (env :as dict) ctx)
|
|
;; NOTE: Uses statement-form let + set! to avoid expression-context
|
|
;; let (IIFE lambdas) which can't contain await in Python.
|
|
(let ((result nil))
|
|
(if (and (list? expr) (not (empty? expr)))
|
|
(let ((head (first expr)))
|
|
(if (and (= (type-of head) "symbol")
|
|
(starts-with? (symbol-name head) "~"))
|
|
(let ((name (symbol-name head))
|
|
(val (if (env-has? env name) (env-get env name) nil)))
|
|
(if (component? val)
|
|
(set! result (async-aser-component val (rest expr) env ctx))
|
|
(set! result (async-maybe-expand-result (async-aser expr env ctx) env ctx))))
|
|
(set! result (async-maybe-expand-result (async-aser expr env ctx) env ctx))))
|
|
(set! result (async-maybe-expand-result (async-aser expr env ctx) env ctx)))
|
|
;; Normalize result to SxExpr
|
|
(if (sx-expr? result)
|
|
result
|
|
(if (nil? result)
|
|
(make-sx-expr "")
|
|
(if (string? result)
|
|
(make-sx-expr result)
|
|
(make-sx-expr (serialize result))))))))
|
|
|
|
|
|
(define-async async-maybe-expand-result :effects [render io]
|
|
(fn (result (env :as dict) ctx)
|
|
;; If the aser result is a component call string like "(~foo ...)",
|
|
;; re-parse and expand it. This handles indirect component references
|
|
;; (e.g. a let binding that evaluates to a component call).
|
|
(let ((raw (if (sx-expr? result)
|
|
(trim (str result))
|
|
(if (string? result)
|
|
(trim result)
|
|
nil))))
|
|
(if (and raw (starts-with? raw "(~"))
|
|
(let ((parsed (sx-parse raw)))
|
|
(if (and parsed (not (empty? parsed)))
|
|
(async-eval-slot-inner (first parsed) env ctx)
|
|
result))
|
|
result))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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
|
|
;;
|
|
;; Spread + collect (from render.sx):
|
|
;; (spread? x) — check if spread value
|
|
;; (spread-attrs s) — extract attrs dict from spread
|
|
;; (merge-spread-attrs tgt src) — merge spread attrs onto target
|
|
;; (collect! bucket value) — add to render-time accumulator
|
|
;; (collected bucket) — read render-time accumulator
|
|
;; (clear-collected! bucket) — clear accumulator
|
|
;;
|
|
;; 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
|
|
;; --------------------------------------------------------------------------
|