rose-ash/shared/sx/ref/adapter-sx.sx

;; ==========================================================================
;; adapter-sx.sx — SX wire format rendering adapter
;;
;; Serializes SX expressions for client-side rendering.
;; Component calls are NOT expanded — they're sent to the client as-is.
;; HTML tags are serialized as SX source text. Special forms are evaluated.
;;
;; Depends on:
;;   render.sx  — HTML_TAGS
;;   eval.sx    — eval-expr, trampoline, call-lambda, expand-macro
;; ==========================================================================


(define render-to-sx :effects [render]
  (fn (expr (env :as dict))
    (let ((result (aser expr env)))
      ;; aser-call already returns serialized SX strings;
      ;; only serialize non-string values
      (if (= (type-of result) "string")
        result
        (serialize result)))))

(define aser :effects [render]
  (fn ((expr :as any) (env :as dict))
    ;; Evaluate for SX wire format — serialize rendering forms,
    ;; evaluate control flow and function calls.
    (set-render-active! true)
    (case (type-of expr)
      "number"  expr
      "string"  expr
      "boolean" expr
      "nil"     nil

      "symbol"
        (let ((name (symbol-name expr)))
          (cond
            (env-has? env name)     (env-get env name)
            (primitive? name)       (get-primitive name)
            (= name "true")        true
            (= name "false")       false
            (= name "nil")         nil
            :else (error (str "Undefined symbol: " name))))

      "keyword" (keyword-name expr)

      "list"
        (if (empty? expr)
          (list)
          (aser-list expr env))

      ;; Spread — pass through for client rendering
      "spread"  expr

      :else expr)))


(define aser-list :effects [render]
  (fn ((expr :as list) (env :as dict))
    (let ((head (first expr))
          (args (rest expr)))
      (if (not (= (type-of head) "symbol"))
        (map (fn (x) (aser x env)) expr)
        (let ((name (symbol-name head)))
          (cond
            ;; Fragment — serialize children
            (= name "<>")
              (aser-fragment args env)

            ;; Component call — serialize WITHOUT expanding
            (starts-with? name "~")
              (aser-call name args env)

            ;; Lake — serialize (server-morphable slot)
            (= name "lake")
              (aser-call name args env)

            ;; Marsh — serialize (reactive server-morphable slot)
            (= name "marsh")
              (aser-call name args env)

            ;; HTML tag — serialize
            (contains? HTML_TAGS name)
              (aser-call name args env)

            ;; Special/HO forms — evaluate (produces data)
            (or (special-form? name) (ho-form? name))
              (aser-special name expr env)

            ;; Macro — expand then aser
            (and (env-has? env name) (macro? (env-get env name)))
              (aser (expand-macro (env-get env name) args env) env)

            ;; Function call — evaluate fully
            :else
              (let ((f (trampoline (eval-expr head env)))
                    (evaled-args (map (fn (a) (trampoline (eval-expr a env))) args)))
                (cond
                  (and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
                    (apply f evaled-args)
                  (lambda? f)
                    (trampoline (call-lambda f evaled-args env))
                  (component? f)
                    (aser-call (str "~" (component-name f)) args env)
                  (island? f)
                    (aser-call (str "~" (component-name f)) args env)
                  :else (error (str "Not callable: " (inspect f)))))))))))


(define aser-fragment :effects [render]
  (fn ((children :as list) (env :as dict))
    ;; Serialize (<> child1 child2 ...) to sx source string
    ;; Must flatten list results (e.g. from map/filter) to avoid nested parens
    (let ((parts (list)))
      (for-each
        (fn (c)
          (let ((result (aser c env)))
            (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)
        ""
        (str "(<> " (join " " parts) ")")))))


(define aser-call :effects [render]
  (fn ((name :as string) (args :as list) (env :as dict))
    ;; Serialize (name :key val child ...) — evaluate args but keep as sx
    ;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops
    ;; that can contain nested for-each for list flattening.
    (let ((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 (aser (nth args (inc i)) env)))
                (when (not (nil? val))
                  (append! parts (str ":" (keyword-name arg)))
                  (append! parts (serialize val)))
                (set! skip true)
                (set! i (inc i)))
              (let ((val (aser arg env)))
                (when (not (nil? val))
                  (if (= (type-of val) "list")
                    (for-each
                      (fn (item)
                        (when (not (nil? item))
                          (append! parts (serialize item))))
                      val)
                    (append! parts (serialize val))))
                (set! i (inc i))))))
        args)
      (str "(" (join " " parts) ")"))))


;; --------------------------------------------------------------------------
;; Form classification
;; --------------------------------------------------------------------------

(define SPECIAL_FORM_NAMES
  (list "if" "when" "cond" "case" "and" "or"
        "let" "let*" "lambda" "fn"
        "define" "defcomp" "defmacro" "defstyle"
        "defhandler" "defpage" "defquery" "defaction" "defrelation"
        "begin" "do" "quote" "quasiquote"
        "->" "set!" "letrec" "dynamic-wind" "defisland"
        "deftype" "defeffect" "provide"))

(define HO_FORM_NAMES
  (list "map" "map-indexed" "filter" "reduce"
        "some" "every?" "for-each"))

(define special-form? :effects []
  (fn ((name :as string))
    (contains? SPECIAL_FORM_NAMES name)))

(define ho-form? :effects []
  (fn ((name :as string))
    (contains? HO_FORM_NAMES name)))


;; --------------------------------------------------------------------------
;; aser-special — evaluate special/HO forms in aser mode
;; --------------------------------------------------------------------------
;;
;; Control flow forms evaluate conditions normally but render branches
;; through aser (serializing tags/components instead of rendering HTML).
;; Definition forms evaluate for side effects and return nil.

(define aser-special :effects [render]
  (fn ((name :as string) (expr :as list) (env :as dict))
    (let ((args (rest expr)))
      (cond
        ;; if — evaluate condition, aser chosen branch
        (= name "if")
          (if (trampoline (eval-expr (first args) env))
            (aser (nth args 1) env)
            (if (> (len args) 2)
              (aser (nth args 2) env)
              nil))

        ;; when — evaluate condition, aser body if true
        (= name "when")
          (if (not (trampoline (eval-expr (first args) env)))
            nil
            (let ((result nil))
              (for-each (fn (body) (set! result (aser body env)))
                        (rest args))
              result))

        ;; cond — evaluate conditions, aser matching branch
        (= name "cond")
          (let ((branch (eval-cond args env)))
            (if branch (aser branch env) nil))

        ;; case — evaluate match value, check each pair
        (= name "case")
          (let ((match-val (trampoline (eval-expr (first args) env)))
                (clauses (rest args)))
            (eval-case-aser match-val clauses env))

        ;; let / let*
        (or (= name "let") (= name "let*"))
          (let ((local (process-bindings (first args) env))
                (result nil))
            (for-each (fn (body) (set! result (aser body local)))
                      (rest args))
            result)

        ;; begin / do
        (or (= name "begin") (= name "do"))
          (let ((result nil))
            (for-each (fn (body) (set! result (aser body env))) args)
            result)

        ;; and — short-circuit
        (= name "and")
          (let ((result true))
            (some (fn (arg)
                    (set! result (trampoline (eval-expr arg env)))
                    (not result))
                  args)
            result)

        ;; or — short-circuit
        (= name "or")
          (let ((result false))
            (some (fn (arg)
                    (set! result (trampoline (eval-expr arg env)))
                    result)
                  args)
            result)

        ;; map — evaluate function and collection, map through aser
        (= name "map")
          (let ((f (trampoline (eval-expr (first args) env)))
                (coll (trampoline (eval-expr (nth args 1) env))))
            (map (fn (item)
                   (if (lambda? f)
                     (let ((local (env-merge (lambda-closure f) env)))
                       (env-set! local (first (lambda-params f)) item)
                       (aser (lambda-body f) local))
                     (invoke f item)))
                 coll))

        ;; map-indexed
        (= name "map-indexed")
          (let ((f (trampoline (eval-expr (first args) env)))
                (coll (trampoline (eval-expr (nth args 1) env))))
            (map-indexed (fn (i item)
                           (if (lambda? f)
                             (let ((local (env-merge (lambda-closure f) env)))
                               (env-set! local (first (lambda-params f)) i)
                               (env-set! local (nth (lambda-params f) 1) item)
                               (aser (lambda-body f) local))
                             (invoke f i item)))
                         coll))

        ;; for-each — evaluate for side effects, aser each body
        (= name "for-each")
          (let ((f (trampoline (eval-expr (first args) env)))
                (coll (trampoline (eval-expr (nth args 1) env)))
                (results (list)))
            (for-each (fn (item)
                        (if (lambda? f)
                          (let ((local (env-merge (lambda-closure f) env)))
                            (env-set! local (first (lambda-params f)) item)
                            (append! results (aser (lambda-body f) local)))
                          (invoke f item)))
                      coll)
            (if (empty? results) nil results))

        ;; defisland — evaluate AND serialize (client needs the definition)
        (= name "defisland")
          (do (trampoline (eval-expr expr env))
              (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 "defrelation")
            (= name "deftype") (= name "defeffect"))
          (do (trampoline (eval-expr expr env)) nil)

        ;; provide — render-time dynamic scope
        (= name "provide")
          (let ((prov-name (trampoline (eval-expr (first args) env)))
                (prov-val (trampoline (eval-expr (nth args 1) env)))
                (result nil))
            (provide-push! prov-name prov-val)
            (for-each (fn (body) (set! result (aser body env)))
                      (slice args 2))
            (provide-pop! prov-name)
            result)

        ;; Everything else — evaluate normally
        :else
          (trampoline (eval-expr expr env))))))


;; Helper: case dispatch for aser mode
(define eval-case-aser :effects [render]
  (fn (match-val (clauses :as list) (env :as dict))
    (if (< (len clauses) 2)
      nil
      (let ((test (first clauses))
            (body (nth clauses 1)))
        (if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
                (and (= (type-of test) "symbol")
                     (or (= (symbol-name test) ":else")
                         (= (symbol-name test) "else"))))
          (aser body env)
          (if (= match-val (trampoline (eval-expr test env)))
            (aser body env)
            (eval-case-aser match-val (slice clauses 2) env)))))))


;; --------------------------------------------------------------------------
;; Platform interface — SX wire adapter
;; --------------------------------------------------------------------------
;;
;; From eval.sx:
;;   eval-expr, trampoline, call-lambda, expand-macro
;;   env-has?, env-get, env-set!, env-merge, callable?, lambda?, component?,
;;   macro?, island?, primitive?, get-primitive, component-name
;;   lambda-closure, lambda-params, lambda-body
;;
;; From render.sx:
;;   HTML_TAGS, eval-cond, process-bindings
;;
;; From parser.sx:
;;   serialize (= sx-serialize)
;;
;; From signals.sx (optional):
;;   invoke
;; --------------------------------------------------------------------------