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
  (fn (expr env)
    (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
  (fn (expr env)
    ;; 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))

      :else expr)))


(define aser-list
  (fn (expr env)
    (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
  (fn (children env)
    ;; Serialize (<> child1 child2 ...) to sx source string
    (let ((parts (filter
                   (fn (x) (not (nil? x)))
                   (map (fn (c) (aser c env)) children))))
      (if (empty? parts)
        ""
        (str "(<> " (join " " (map serialize parts)) ")")))))


(define aser-call
  (fn (name args env)
    ;; Serialize (name :key val child ...) — evaluate args but keep as sx
    (let ((parts (list name)))
      (reduce
        (fn (state arg)
          (let ((skip (get state "skip")))
            (if skip
              (assoc state "skip" false "i" (inc (get state "i")))
              (if (and (= (type-of arg) "keyword")
                       (< (inc (get state "i")) (len args)))
                (let ((val (aser (nth args (inc (get state "i"))) env)))
                  (when (not (nil? val))
                    (append! parts (str ":" (keyword-name arg)))
                    (append! parts (serialize val)))
                  (assoc state "skip" true "i" (inc (get state "i"))))
                (let ((val (aser arg env)))
                  (when (not (nil? val))
                    (append! parts (serialize val)))
                  (assoc state "i" (inc (get state "i"))))))))
        (dict "i" 0 "skip" false)
        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"))

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

(define special-form?
  (fn (name)
    (contains? SPECIAL_FORM_NAMES name)))

(define ho-form?
  (fn (name)
    (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
  (fn (name expr env)
    (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"))
          (do (trampoline (eval-expr expr env)) nil)

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


;; Helper: case dispatch for aser mode
(define eval-case-aser
  (fn (match-val clauses env)
    (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
;; --------------------------------------------------------------------------