;; ==========================================================================
;; 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"   (do (emit! "element-attrs" (spread-attrs 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
            (= 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 :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) ">")
        ;; Provide scope for spread emit!
        (let ((token (if (or (= tag "svg") (= tag "math"))
                       (svg-context-set! true)
                       nil))
              (content-parts (list)))
          (scope-push! "element-attrs" nil)
          (for-each
            (fn (c) (append! content-parts (async-render c env ctx)))
            children)
          (for-each
            (fn (spread-dict) (merge-spread-attrs attrs spread-dict))
            (emitted "element-attrs"))
          (scope-pop! "element-attrs")
          (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-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
          (component-params comp))
        ;; Pre-render children to raw HTML
        (when (component-has-children? comp)
          (let ((parts (list)))
            (for-each
              (fn (c) (append! parts (async-render c env ctx)))
              children)
            (env-bind! 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-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
          (component-params island))
        ;; Pre-render children
        (when (component-has-children? island)
          (let ((parts (list)))
            (for-each
              (fn (c) (append! parts (async-render c env ctx)))
              children)
            (env-bind! 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-bind! 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" "scope" "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. 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)
            (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* — 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)
            (join "" (async-map-render (slice expr 2) local ctx))))

      ;; 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)
          (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)))

      ;; scope — unified render-time dynamic scope
      (= name "scope")
        (let ((scope-name (async-eval (nth expr 1) env ctx))
              (rest-args (slice expr 2))
              (scope-val nil)
              (body-exprs nil))
          ;; Check for :value keyword
          (if (and (>= (len rest-args) 2)
                   (= (type-of (first rest-args)) "keyword")
                   (= (keyword-name (first rest-args)) "value"))
            (do (set! scope-val (async-eval (nth rest-args 1) env ctx))
                (set! body-exprs (slice rest-args 2)))
            (set! body-exprs rest-args))
          (scope-push! scope-name scope-val)
          (let ((result (if (= (len body-exprs) 1)
                          (async-render (first body-exprs) env ctx)
                          (join "" (async-map-render body-exprs env ctx)))))
            (scope-pop! scope-name)
            result))

      ;; provide — sugar for scope with value
      (= 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)))
          (scope-push! prov-name prov-val)
          (let ((result (if (= body-count 1)
                          (async-render (nth expr body-start) env ctx)
                          (join "" (async-map-render (slice expr body-start) env ctx)))))
            (scope-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-bind! 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-bind! 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)
    (let ((t (type-of expr))
          (result nil))
      (cond
        (= t "number")  (set! result expr)
        (= t "string")  (set! result expr)
        (= t "boolean") (set! result expr)
        (= t "nil")     (set! result nil)
        (= t "symbol")
          (let ((name (symbol-name expr)))
            (set! result
              (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)))))
        (= t "keyword") (set! result (keyword-name expr))
        (= t "dict")    (set! result (async-aser-dict expr env ctx))
        ;; Spread — emit attrs to nearest element provider
        (= t "spread")  (do (emit! "element-attrs" (spread-attrs expr))
                             (set! result nil))
        (= t "list")    (set! result (if (empty? expr) (list) (async-aser-list expr env ctx)))
        :else            (set! result expr))
      ;; Catch spread values from function calls and symbol lookups
      (if (spread? result)
        (do (emit! "element-attrs" (spread-attrs result)) nil)
        result))))


(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-bind! 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-bind! 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-bind! 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))
          (attr-parts (list))
          (child-parts (list))
          (skip false)
          (i 0))
      ;; Provide scope for spread emit!
      (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 (async-aser (nth args (inc i)) env ctx)))
                (when (not (nil? val))
                  (append! attr-parts (str ":" (keyword-name arg)))
                  (if (= (type-of val) "list")
                    (let ((live (filter (fn (v) (not (nil? v))) val)))
                      (if (empty? live)
                        (append! attr-parts "nil")
                        (let ((items (map serialize live)))
                          (if (some (fn (v) (sx-expr? v)) live)
                            (append! attr-parts (str "(<> " (join " " items) ")"))
                            (append! attr-parts (str "(list " (join " " items) ")"))))))
                    (append! attr-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! child-parts (serialize item))))
                      result)
                    (append! child-parts (serialize result))))
                (set! i (inc i))))))
        args)
      ;; Collect emitted spread attrs — after explicit attrs, before children
      (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)))
        (emitted "element-attrs"))
      (scope-pop! "element-attrs")
      (when token (svg-context-reset! token))
      (let ((parts (concat (list name) attr-parts child-parts)))
        (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" "scope" "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-bind! 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)

        ;; scope — unified render-time dynamic scope
        (= name "scope")
          (let ((scope-name (async-eval (first args) env ctx))
                (rest-args (rest args))
                (scope-val nil)
                (body-args nil))
            ;; Check for :value keyword
            (if (and (>= (len rest-args) 2)
                     (= (type-of (first rest-args)) "keyword")
                     (= (keyword-name (first rest-args)) "value"))
              (do (set! scope-val (async-eval (nth rest-args 1) env ctx))
                  (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 (async-aser body env ctx)))
                        body-args)
              (scope-pop! scope-name)
              result))

        ;; provide — sugar for scope with value
        (= name "provide")
          (let ((prov-name (async-eval (first args) env ctx))
                (prov-val (async-eval (nth args 1) env ctx))
                (result nil))
            (scope-push! prov-name prov-val)
            (for-each (fn (body) (set! result (async-aser body env ctx)))
                      (slice args 2))
            (scope-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-bind! 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-bind! 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-bind! local (first (lambda-params f)) i)
              (env-bind! 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-bind! 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
;; --------------------------------------------------------------------------