;; _hyperscript compiler — AST → SX expressions
;;
;; Input:  AST from hs-parse (list structures)
;; Output: SX expressions targeting web/lib/dom.sx primitives
;;
;; Usage:
;;   (hs-to-sx (hs-compile "on click add .active to me"))
;;   → (hs-on me "click" (fn (event) (dom-add-class me "active")))

(define
  hs-to-sx
  (let
    ((dot-sym (make-symbol ".")) (pct-sym (make-symbol "%")))
    (define emit-target (fn (ast) (hs-to-sx ast)))
    (define
      emit-set
      (fn
        (target value)
        (if
          (not (list? target))
          (list (quote set!) target value)
          (let
            ((th (first target)))
            (cond
              ((= th dot-sym)
                (list
                  (quote dom-set-prop)
                  (hs-to-sx (nth target 1))
                  (nth target 2)
                  value))
              ((= th (quote attr))
                (list
                  (quote dom-set-attr)
                  (hs-to-sx (nth target 2))
                  (nth target 1)
                  value))
              ((= th (quote style))
                (list
                  (quote dom-set-style)
                  (hs-to-sx (nth target 2))
                  (nth target 1)
                  value))
              ((= th (quote ref))
                (list (quote set!) (make-symbol (nth target 1)) value))
              ((= th (quote local))
                (list (quote set!) (make-symbol (nth target 1)) value))
              ((= th (quote me))
                (list (quote dom-set-inner-html) (quote me) value))
              ((= th (quote it)) (list (quote set!) (quote it) value))
              ((= th (quote query))
                (list (quote dom-set-inner-html) (hs-to-sx target) value))
              ((= th (quote array-index))
                (list
                  (quote host-set!)
                  (hs-to-sx (nth target 1))
                  (hs-to-sx (nth target 2))
                  value))
              ((= th (quote of))
                (let
                  ((prop-ast (nth target 1)) (obj-ast (nth target 2)))
                  (if
                    (and (list? prop-ast) (= (first prop-ast) dot-sym))
                    (let
                      ((base (nth prop-ast 1))
                        (prop-name (nth prop-ast 2)))
                      (list
                        (quote dom-set-prop)
                        (list
                          (quote host-get)
                          (hs-to-sx obj-ast)
                          (nth base 1))
                        prop-name
                        value))
                    (if
                      (and
                        (list? prop-ast)
                        (= (first prop-ast) (quote attr)))
                      (list
                        (quote dom-set-attr)
                        (hs-to-sx obj-ast)
                        (nth prop-ast 1)
                        value)
                      (if
                        (and
                          (list? prop-ast)
                          (= (first prop-ast) (quote ref)))
                        (list
                          (quote dom-set-prop)
                          (hs-to-sx obj-ast)
                          (nth prop-ast 1)
                          value)
                        (list (quote set!) (hs-to-sx target) value))))))
              (true (list (quote set!) (hs-to-sx target) value)))))))
    (define
      emit-on
      (fn
        (ast)
        (let
          ((parts (rest ast)))
          (let
            ((event-name (first parts)))
            (define
              scan-on
              (fn
                (items source filter every? catch-info finally-info)
                (cond
                  ((<= (len items) 1)
                    (let
                      ((body (if (> (len items) 0) (first items) nil)))
                      (let
                        ((target (if source (hs-to-sx source) (quote me))))
                        (let
                          ((compiled-body (hs-to-sx body))
                            (wrapped-body
                              (if
                                catch-info
                                (let
                                  ((var (make-symbol (first catch-info)))
                                    (catch-body
                                      (hs-to-sx (nth catch-info 1))))
                                  (if
                                    finally-info
                                    (list
                                      (quote do)
                                      (list
                                        (quote guard)
                                        (list var (list true catch-body))
                                        compiled-body)
                                      (hs-to-sx finally-info))
                                    (list
                                      (quote guard)
                                      (list var (list true catch-body))
                                      compiled-body)))
                                (if
                                  finally-info
                                  (list
                                    (quote do)
                                    compiled-body
                                    (hs-to-sx finally-info))
                                  compiled-body)))
                            (handler
                              (list
                                (quote fn)
                                (list (quote event))
                                wrapped-body)))
                          (if
                            every?
                            (list
                              (quote hs-on-every)
                              target
                              event-name
                              handler)
                            (list (quote hs-on) target event-name handler))))))
                  ((= (first items) :from)
                    (scan-on
                      (rest (rest items))
                      (nth items 1)
                      filter
                      every?
                      catch-info
                      finally-info))
                  ((= (first items) :filter)
                    (scan-on
                      (rest (rest items))
                      source
                      (nth items 1)
                      every?
                      catch-info
                      finally-info))
                  ((= (first items) :every)
                    (scan-on
                      (rest (rest items))
                      source
                      filter
                      true
                      catch-info
                      finally-info))
                  ((= (first items) :catch)
                    (scan-on
                      (rest (rest items))
                      source
                      filter
                      every?
                      (nth items 1)
                      finally-info))
                  ((= (first items) :finally)
                    (scan-on
                      (rest (rest items))
                      source
                      filter
                      every?
                      catch-info
                      (nth items 1)))
                  (true
                    (scan-on
                      (rest items)
                      source
                      filter
                      every?
                      catch-info
                      finally-info)))))
            (scan-on (rest parts) nil nil false nil nil)))))
    (define
      emit-send
      (fn
        (ast)
        (let
          ((name (nth ast 1)) (rest-parts (rest (rest ast))))
          (cond
            ((and (= (len ast) 4) (list? (nth ast 2)) (= (first (nth ast 2)) (quote dict)))
              (list
                (quote dom-dispatch)
                (hs-to-sx (nth ast 3))
                name
                (hs-to-sx (nth ast 2))))
            ((= (len ast) 3)
              (list (quote dom-dispatch) (hs-to-sx (nth ast 2)) name nil))
            (true (list (quote dom-dispatch) (quote me) name nil))))))
    (define
      emit-repeat
      (fn
        (ast)
        (let
          ((mode (nth ast 1)) (body (hs-to-sx (nth ast 2))))
          (cond
            ((and (list? mode) (= (first mode) (quote forever)))
              (list
                (quote hs-repeat-forever)
                (list (quote fn) (list) body)))
            ((and (list? mode) (= (first mode) (quote times)))
              (list
                (quote hs-repeat-times)
                (hs-to-sx (nth mode 1))
                (list (quote fn) (list) body)))
            ((number? mode)
              (list
                (quote hs-repeat-times)
                mode
                (list (quote fn) (list) body)))
            (true
              (list
                (quote hs-repeat-times)
                (hs-to-sx mode)
                (list (quote fn) (list) body)))))))
    (define
      emit-for
      (fn
        (ast)
        (let
          ((var-name (nth ast 1))
            (collection (hs-to-sx (nth ast 2)))
            (body (hs-to-sx (nth ast 3))))
          (if
            (and (> (len ast) 4) (= (nth ast 4) :index))
            (list
              (quote for-each)
              (list
                (quote fn)
                (list (make-symbol var-name) (make-symbol (nth ast 5)))
                body)
              collection)
            (list
              (quote for-each)
              (list (quote fn) (list (make-symbol var-name)) body)
              collection)))))
    (define
      emit-wait-for
      (fn
        (ast)
        (let
          ((event-name (nth ast 1)))
          (if
            (and (> (len ast) 2) (= (nth ast 2) :from))
            (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name)
            (list (quote hs-wait-for) (quote me) event-name)))))
    (define
      emit-transition
      (fn
        (ast)
        (let
          ((prop (hs-to-sx (nth ast 1)))
            (value (hs-to-sx (nth ast 2)))
            (dur (nth ast 3))
            (raw-tgt (nth ast 4)))
          (list
            (quote hs-transition)
            (if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
            prop
            value
            (if dur (hs-to-sx dur) nil)))))
    (define
      emit-make
      (fn
        (ast)
        (if
          (= (len ast) 3)
          (list
            (quote let)
            (list
              (list
                (make-symbol (nth ast 2))
                (list (quote hs-make) (nth ast 1))))
            (make-symbol (nth ast 2)))
          (list (quote hs-make) (nth ast 1)))))
    (define
      emit-inc
      (fn
        (expr amount tgt-override)
        (cond
          ((and (list? expr) (= (first expr) (quote attr)))
            (let
              ((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
              (list
                (quote dom-set-attr)
                el
                (nth expr 1)
                (list
                  (quote +)
                  (list
                    (quote parse-number)
                    (list (quote dom-get-attr) el (nth expr 1)))
                  amount))))
          ((and (list? expr) (= (first expr) dot-sym))
            (let
              ((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
              (list
                (quote host-set!)
                obj
                prop
                (list
                  (quote +)
                  (list
                    (quote parse-number)
                    (list (quote host-get) obj prop))
                  amount))))
          ((and (list? expr) (= (first expr) (quote style)))
            (let
              ((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
                (prop (nth expr 1)))
              (list
                (quote dom-set-style)
                el
                prop
                (list
                  (quote +)
                  (list
                    (quote parse-number)
                    (list (quote dom-get-style) el prop))
                  amount))))
          (true
            (let
              ((t (hs-to-sx expr)))
              (list
                (quote set!)
                t
                (list (quote +) (list (quote or) t 0) amount)))))))
    (define
      emit-dec
      (fn
        (expr amount tgt-override)
        (cond
          ((and (list? expr) (= (first expr) (quote attr)))
            (let
              ((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
              (list
                (quote dom-set-attr)
                el
                (nth expr 1)
                (list
                  (quote -)
                  (list
                    (quote parse-number)
                    (list (quote dom-get-attr) el (nth expr 1)))
                  amount))))
          ((and (list? expr) (= (first expr) dot-sym))
            (let
              ((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
              (list
                (quote host-set!)
                obj
                prop
                (list
                  (quote -)
                  (list
                    (quote parse-number)
                    (list (quote host-get) obj prop))
                  amount))))
          ((and (list? expr) (= (first expr) (quote style)))
            (let
              ((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
                (prop (nth expr 1)))
              (list
                (quote dom-set-style)
                el
                prop
                (list
                  (quote -)
                  (list
                    (quote parse-number)
                    (list (quote dom-get-style) el prop))
                  amount))))
          (true
            (let
              ((t (hs-to-sx expr)))
              (list
                (quote set!)
                t
                (list (quote -) (list (quote or) t 0) amount)))))))
    (define
      emit-behavior
      (fn
        (ast)
        (let
          ((name (nth ast 1)) (params (nth ast 2)) (body (nth ast 3)))
          (list
            (quote define)
            (make-symbol name)
            (list
              (quote fn)
              (cons (quote me) (map make-symbol params))
              (cons (quote do) (map hs-to-sx body)))))))
    (fn
      (ast)
      (cond
        ((nil? ast) nil)
        ((number? ast) ast)
        ((string? ast) ast)
        ((boolean? ast) ast)
        ((not (list? ast)) ast)
        (true
          (let
            ((head (first ast)))
            (cond
              ((= head (quote null-literal)) nil)
              ((= head (quote not))
                (list (quote not) (hs-to-sx (nth ast 1))))
              ((or (= head (quote starts-with?)) (= head (quote ends-with?)) (= head (quote contains?)) (= head (quote precedes?)) (= head (quote follows?)) (= head (quote exists?)))
                (cons head (map hs-to-sx (rest ast))))
              ((= head (quote object-literal))
                (let
                  ((pairs (nth ast 1)))
                  (if
                    (= (len pairs) 0)
                    (list (quote dict))
                    (cons
                      (quote hs-make-object)
                      (list
                        (cons
                          (quote list)
                          (map
                            (fn
                              (pair)
                              (list
                                (quote list)
                                (first pair)
                                (hs-to-sx (nth pair 1))))
                            pairs)))))))
              ((= head (quote template))
                (let
                  ((raw (nth ast 1)))
                  (let
                    ((parts (list)) (buf "") (i 0) (n (len raw)))
                    (define
                      tpl-flush
                      (fn
                        ()
                        (when
                          (> (len buf) 0)
                          (set! parts (append parts (list buf)))
                          (set! buf ""))))
                    (define
                      tpl-read-id
                      (fn
                        (j)
                        (if
                          (and
                            (< j n)
                            (let
                              ((c (nth raw j)))
                              (or
                                (and (>= c "a") (<= c "z"))
                                (and (>= c "A") (<= c "Z"))
                                (and (>= c "0") (<= c "9"))
                                (= c "_")
                                (= c "."))))
                          (tpl-read-id (+ j 1))
                          j)))
                    (define
                      tpl-find-close
                      (fn
                        (j depth)
                        (if
                          (>= j n)
                          j
                          (if
                            (= (nth raw j) "}")
                            (if
                              (= depth 1)
                              j
                              (tpl-find-close (+ j 1) (- depth 1)))
                            (if
                              (= (nth raw j) "{")
                              (tpl-find-close (+ j 1) (+ depth 1))
                              (tpl-find-close (+ j 1) depth))))))
                    (define
                      tpl-collect
                      (fn
                        ()
                        (when
                          (< i n)
                          (let
                            ((ch (nth raw i)))
                            (if
                              (and (= ch "$") (< (+ i 1) n))
                              (if
                                (= (nth raw (+ i 1)) "{")
                                (let
                                  ((start (+ i 2)))
                                  (let
                                    ((close (tpl-find-close start 1)))
                                    (let
                                      ((expr-src (slice raw start close)))
                                      (do
                                        (tpl-flush)
                                        (set!
                                          parts
                                          (append
                                            parts
                                            (list
                                              (hs-to-sx (hs-compile expr-src)))))
                                        (set! i (+ close 1))
                                        (tpl-collect)))))
                                (let
                                  ((start (+ i 1)))
                                  (let
                                    ((end (tpl-read-id start)))
                                    (let
                                      ((ident (slice raw start end)))
                                      (do
                                        (tpl-flush)
                                        (set!
                                          parts
                                          (append
                                            parts
                                            (list
                                              (hs-to-sx (hs-compile ident)))))
                                        (set! i end)
                                        (tpl-collect))))))
                              (do
                                (set! buf (str buf ch))
                                (set! i (+ i 1))
                                (tpl-collect)))))))
                    (tpl-collect)
                    (tpl-flush)
                    (cons (quote str) parts))))
              ((= head (quote beep!))
                (list (quote hs-beep) (hs-to-sx (nth ast 1))))
              ((= head (quote array-index))
                (list
                  (quote nth)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote array-slice))
                (list
                  (quote hs-slice)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 3))))
              ((= head (quote prop-is))
                (list
                  (quote hs-prop-is)
                  (hs-to-sx (nth ast 1))
                  (nth ast 2)))
              ((= head (quote coll-where))
                (list
                  (quote filter)
                  (list
                    (quote fn)
                    (list (quote it))
                    (hs-to-sx (nth ast 2)))
                  (hs-to-sx (nth ast 1))))
              ((= head (quote coll-sorted))
                (list
                  (quote hs-sorted-by)
                  (hs-to-sx (nth ast 1))
                  (list
                    (quote fn)
                    (list (quote it))
                    (hs-to-sx (nth ast 2)))))
              ((= head (quote coll-sorted-desc))
                (list
                  (quote hs-sorted-by-desc)
                  (hs-to-sx (nth ast 1))
                  (list
                    (quote fn)
                    (list (quote it))
                    (hs-to-sx (nth ast 2)))))
              ((= head (quote coll-mapped))
                (list
                  (quote map)
                  (list
                    (quote fn)
                    (list (quote it))
                    (hs-to-sx (nth ast 2)))
                  (hs-to-sx (nth ast 1))))
              ((= head (quote coll-split))
                (list
                  (quote hs-split-by)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote coll-joined))
                (list
                  (quote hs-joined-by)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote method-call))
                (let
                  ((dot-node (nth ast 1))
                    (args (map hs-to-sx (nth ast 2))))
                  (if
                    (and
                      (list? dot-node)
                      (= (first dot-node) (make-symbol ".")))
                    (let
                      ((obj (hs-to-sx (nth dot-node 1)))
                        (method (nth dot-node 2)))
                      (cons
                        (quote hs-method-call)
                        (cons obj (cons method args))))
                    (cons
                      (quote hs-method-call)
                      (cons (hs-to-sx dot-node) args)))))
              ((= head (quote string-postfix))
                (list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
              ((= head (quote block-literal))
                (let
                  ((params (map make-symbol (nth ast 1)))
                    (body (hs-to-sx (nth ast 2))))
                  (if
                    (= (len params) 0)
                    body
                    (list (quote fn) params body))))
              ((= head (quote me)) (quote me))
              ((= head (quote it)) (quote it))
              ((= head (quote event)) (quote event))
              ((= head dot-sym)
                (let
                  ((target (hs-to-sx (nth ast 1))) (prop (nth ast 2)))
                  (cond
                    ((= prop "first") (list (quote hs-first) target))
                    ((= prop "last") (list (quote hs-last) target))
                    (true (list (quote host-get) target prop)))))
              ((= head (quote ref)) (make-symbol (nth ast 1)))
              ((= head (quote query))
                (list (quote hs-query-first) (nth ast 1)))
              ((= head (quote attr))
                (list
                  (quote dom-get-attr)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote style))
                (list
                  (quote dom-get-style)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote has-class?))
                (list
                  (quote dom-has-class?)
                  (hs-to-sx (nth ast 1))
                  (nth ast 2)))
              ((= head (quote local)) (make-symbol (nth ast 1)))
              ((= head (quote array))
                (cons (quote list) (map hs-to-sx (rest ast))))
              ((= head (quote not))
                (list (quote not) (hs-to-sx (nth ast 1))))
              ((= head (quote no))
                (list (quote hs-falsy?) (hs-to-sx (nth ast 1))))
              ((= head (quote and))
                (list
                  (quote and)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote or))
                (list
                  (quote or)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote =))
                (list
                  (quote =)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote +))
                (list
                  (quote hs-add)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote -))
                (list
                  (quote -)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote *))
                (list
                  (quote *)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote /))
                (list
                  (quote /)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head pct-sym)
                (if
                  (nil? (nth ast 2))
                  (list (quote str) (hs-to-sx (nth ast 1)) "%")
                  (list
                    (quote modulo)
                    (hs-to-sx (nth ast 1))
                    (hs-to-sx (nth ast 2)))))
              ((= head (quote empty?))
                (list (quote hs-empty?) (hs-to-sx (nth ast 1))))
              ((= head (quote exists?))
                (list
                  (quote not)
                  (list (quote nil?) (hs-to-sx (nth ast 1)))))
              ((= head (quote matches?))
                (let
                  ((left (nth ast 1)) (right (nth ast 2)))
                  (if
                    (and (list? right) (= (first right) (quote query)))
                    (list (quote hs-matches?) (hs-to-sx left) (nth right 1))
                    (list
                      (quote hs-matches?)
                      (hs-to-sx left)
                      (hs-to-sx right)))))
              ((= head (quote matches-ignore-case?))
                (list
                  (quote hs-matches-ignore-case?)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote starts-with-ic?))
                (list
                  (quote hs-starts-with-ic?)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote ends-with-ic?))
                (list
                  (quote hs-ends-with-ic?)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote contains?))
                (list
                  (quote hs-contains?)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote contains-ignore-case?))
                (list
                  (quote hs-contains-ignore-case?)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote as))
                (list (quote hs-coerce) (hs-to-sx (nth ast 1)) (nth ast 2)))
              ((= head (quote in?))
                (list
                  (quote hs-contains?)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 1))))
              ((= head (quote of))
                (let
                  ((prop (hs-to-sx (nth ast 1)))
                    (target (hs-to-sx (nth ast 2))))
                  (cond
                    ((= prop (quote first)) (list (quote first) target))
                    ((= prop (quote last)) (list (quote last) target))
                    (true (list (quote host-get) target prop)))))
              ((= head "!=")
                (list
                  (quote not)
                  (list
                    (quote =)
                    (hs-to-sx (nth ast 1))
                    (hs-to-sx (nth ast 2)))))
              ((= head "<")
                (list
                  (quote <)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head ">")
                (list
                  (quote >)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head "<=")
                (list
                  (quote <=)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head ">=")
                (list
                  (quote >=)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote closest))
                (list
                  (quote dom-closest)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote next))
                (list (quote hs-next) (hs-to-sx (nth ast 2)) (nth ast 1)))
              ((= head (quote previous))
                (list
                  (quote hs-previous)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote first))
                (if
                  (> (len ast) 2)
                  (list
                    (quote hs-first)
                    (hs-to-sx (nth ast 2))
                    (nth ast 1))
                  (list (quote hs-query-first) (nth ast 1))))
              ((= head (quote last))
                (if
                  (> (len ast) 2)
                  (list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
                  (list (quote hs-query-last) (nth ast 1))))
              ((= head (quote add-class))
                (let
                  ((raw-tgt (nth ast 2)))
                  (if
                    (and (list? raw-tgt) (= (first raw-tgt) (quote query)))
                    (list
                      (quote for-each)
                      (list
                        (quote fn)
                        (list (quote _el))
                        (list (quote dom-add-class) (quote _el) (nth ast 1)))
                      (list (quote hs-query-all) (nth raw-tgt 1)))
                    (list
                      (quote dom-add-class)
                      (hs-to-sx raw-tgt)
                      (nth ast 1)))))
              ((= head (quote multi-add-class))
                (let
                  ((target (hs-to-sx (nth ast 1)))
                    (classes (rest (rest ast))))
                  (cons
                    (quote do)
                    (map
                      (fn (cls) (list (quote dom-add-class) target cls))
                      classes))))
              ((= head (quote add-class-when))
                (let
                  ((cls (nth ast 1))
                    (raw-tgt (nth ast 2))
                    (when-cond (nth ast 3)))
                  (let
                    ((tgt-expr (cond ((and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1))) ((and (list? raw-tgt) (= (first raw-tgt) (quote in?)) (list? (nth raw-tgt 1)) (= (first (nth raw-tgt 1)) (quote query))) (list (quote host-call) (hs-to-sx (nth raw-tgt 2)) "querySelectorAll" (nth (nth raw-tgt 1) 1))) (true (hs-to-sx raw-tgt)))))
                    (list
                      (quote for-each)
                      (list
                        (quote fn)
                        (list (quote it))
                        (list
                          (quote when)
                          (hs-to-sx when-cond)
                          (list (quote dom-add-class) (quote it) cls)))
                      tgt-expr))))
              ((= head (quote multi-remove-class))
                (let
                  ((target (hs-to-sx (nth ast 1)))
                    (classes (rest (rest ast))))
                  (cons
                    (quote do)
                    (map
                      (fn (cls) (list (quote dom-remove-class) target cls))
                      classes))))
              ((= head (quote remove-class))
                (let
                  ((raw-tgt (nth ast 2)))
                  (if
                    (and (list? raw-tgt) (= (first raw-tgt) (quote query)))
                    (list
                      (quote for-each)
                      (list
                        (quote fn)
                        (list (quote _el))
                        (list
                          (quote dom-remove-class)
                          (quote _el)
                          (nth ast 1)))
                      (list (quote hs-query-all) (nth raw-tgt 1)))
                    (list
                      (quote dom-remove-class)
                      (if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
                      (nth ast 1)))))
              ((= head (quote remove-element))
                (list (quote dom-remove) (hs-to-sx (nth ast 1))))
              ((= head (quote empty-target))
                (list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
              ((= head (quote open-element))
                (list (quote hs-open!) (hs-to-sx (nth ast 1))))
              ((= head (quote close-element))
                (list (quote hs-close!) (hs-to-sx (nth ast 1))))
              ((= head (quote swap!))
                (let
                  ((lhs (nth ast 1)) (rhs (nth ast 2)))
                  (list
                    (quote let)
                    (list (list (quote _swap_tmp) (hs-to-sx lhs)))
                    (list
                      (quote do)
                      (emit-set lhs (hs-to-sx rhs))
                      (emit-set rhs (quote _swap_tmp))))))
              ((= head (quote remove-attr))
                (let
                  ((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
                  (list (quote dom-remove-attr) tgt (nth ast 1))))
              ((= head (quote remove-css))
                (let
                  ((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
                    (props (nth ast 1)))
                  (cons
                    (quote do)
                    (map
                      (fn (p) (list (quote dom-set-style) tgt p ""))
                      props))))
              ((= head (quote toggle-class))
                (list
                  (quote hs-toggle-class!)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote toggle-between))
                (list
                  (quote hs-toggle-between!)
                  (hs-to-sx (nth ast 3))
                  (nth ast 1)
                  (nth ast 2)))
              ((= head (quote toggle-style))
                (let
                  ((raw-tgt (nth ast 2)))
                  (list
                    (quote hs-toggle-style!)
                    (if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
                    (nth ast 1))))
              ((= head (quote toggle-style-between))
                (list
                  (quote hs-toggle-style-between!)
                  (hs-to-sx (nth ast 4))
                  (nth ast 1)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 3))))
              ((= head (quote toggle-attr))
                (list
                  (quote hs-toggle-attr!)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote toggle-attr-between))
                (list
                  (quote hs-toggle-attr-between!)
                  (hs-to-sx (nth ast 4))
                  (nth ast 1)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 3))))
              ((= head (quote set!))
                (emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
              ((= head (quote put!))
                (list
                  (quote hs-put!)
                  (hs-to-sx (nth ast 1))
                  (nth ast 2)
                  (hs-to-sx (nth ast 3))))
              ((= head (quote if))
                (if
                  (> (len ast) 3)
                  (list
                    (quote if)
                    (hs-to-sx (nth ast 1))
                    (hs-to-sx (nth ast 2))
                    (hs-to-sx (nth ast 3)))
                  (list
                    (quote when)
                    (hs-to-sx (nth ast 1))
                    (hs-to-sx (nth ast 2)))))
              ((= head (quote do))
                (cons (quote do) (map hs-to-sx (rest ast))))
              ((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
              ((= head (quote wait-for)) (emit-wait-for ast))
              ((= head (quote log))
                (list (quote console-log) (hs-to-sx (nth ast 1))))
              ((= head (quote send)) (emit-send ast))
              ((= head (quote trigger))
                (list
                  (quote dom-dispatch)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)
                  nil))
              ((= head (quote hide))
                (let
                  ((tgt (hs-to-sx (nth ast 1)))
                    (strategy (if (> (len ast) 2) (nth ast 2) "display")))
                  (list (quote hs-hide!) tgt strategy)))
              ((= head (quote show))
                (let
                  ((tgt (hs-to-sx (nth ast 1)))
                    (strategy (if (> (len ast) 2) (nth ast 2) "display")))
                  (list (quote hs-show!) tgt strategy)))
              ((= head (quote transition)) (emit-transition ast))
              ((= head (quote transition-from))
                (let
                  ((prop (hs-to-sx (nth ast 1)))
                    (from-val (hs-to-sx (nth ast 2)))
                    (to-val (hs-to-sx (nth ast 3)))
                    (dur (nth ast 4))
                    (raw-tgt (nth ast 5)))
                  (list
                    (quote hs-transition-from)
                    (if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
                    prop
                    from-val
                    to-val
                    (if dur (hs-to-sx dur) nil))))
              ((= head (quote repeat)) (emit-repeat ast))
              ((= head (quote fetch))
                (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
              ((= head (quote fetch-gql))
                (list
                  (quote hs-fetch-gql)
                  (nth ast 1)
                  (if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
              ((= head (quote call))
                (let
                  ((fn-expr (hs-to-sx (nth ast 1)))
                    (args (map hs-to-sx (nth ast 2))))
                  (cons fn-expr args)))
              ((= head (quote return)) (hs-to-sx (nth ast 1)))
              ((= head (quote throw))
                (list (quote raise) (hs-to-sx (nth ast 1))))
              ((= head (quote settle))
                (list (quote hs-settle) (quote me)))
              ((= head (quote go))
                (list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
              ((= head (quote append!))
                (list
                  (quote dom-append)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 1))))
              ((= head (quote tell))
                (let
                  ((tgt (hs-to-sx (nth ast 1))))
                  (list
                    (quote let)
                    (list
                      (list (quote me) tgt)
                      (list (quote you) tgt)
                      (list (quote yourself) tgt))
                    (hs-to-sx (nth ast 2)))))
              ((= head (quote for)) (emit-for ast))
              ((= head (quote take!))
                (let
                  ((kind (nth ast 1))
                    (name (nth ast 2))
                    (from-sel (if (> (len ast) 3) (nth ast 3) nil))
                    (for-tgt (if (> (len ast) 4) (nth ast 4) nil)))
                  (let
                    ((target (if for-tgt (hs-to-sx for-tgt) (quote me)))
                      (scope
                        (cond
                          ((nil? from-sel) nil)
                          ((and (list? from-sel) (= (first from-sel) (quote query)))
                            (list (quote hs-query-all) (nth from-sel 1)))
                          (true (hs-to-sx from-sel)))))
                    (list (quote hs-take!) target kind name scope))))
              ((= head (quote make)) (emit-make ast))
              ((= head (quote install))
                (cons (quote hs-install) (map hs-to-sx (rest ast))))
              ((= head (quote measure))
                (list (quote hs-measure) (hs-to-sx (nth ast 1))))
              ((= head (quote increment!))
                (emit-inc
                  (nth ast 1)
                  (nth ast 2)
                  (if (> (len ast) 3) (nth ast 3) nil)))
              ((= head (quote decrement!))
                (emit-dec
                  (nth ast 1)
                  (nth ast 2)
                  (if (> (len ast) 3) (nth ast 3) nil)))
              ((= head (quote on)) (emit-on ast))
              ((= head (quote init))
                (list
                  (quote hs-init)
                  (list (quote fn) (list) (hs-to-sx (nth ast 1)))))
              ((= head (quote def))
                (list
                  (quote define)
                  (make-symbol (nth ast 1))
                  (list
                    (quote fn)
                    (map make-symbol (nth ast 2))
                    (hs-to-sx (nth ast 3)))))
              ((= head (quote behavior)) (emit-behavior ast))
              ((= head (quote sx-eval))
                (let
                  ((src (nth ast 1)))
                  (if
                    (string? src)
                    (first (sx-parse src))
                    (list (quote cek-eval) (hs-to-sx src)))))
              ((= head (quote component)) (make-symbol (nth ast 1)))
              ((= head (quote render))
                (let
                  ((comp-raw (nth ast 1))
                    (kwargs (nth ast 2))
                    (pos (if (> (len ast) 3) (nth ast 3) nil))
                    (target
                      (if (> (len ast) 4) (hs-to-sx (nth ast 4)) nil)))
                  (let
                    ((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw))))
                    (define
                      emit-kw-pairs
                      (fn
                        (pairs)
                        (if
                          (< (len pairs) 2)
                          (list)
                          (cons
                            (make-keyword (first pairs))
                            (cons
                              (hs-to-sx (nth pairs 1))
                              (emit-kw-pairs (rest (rest pairs))))))))
                    (let
                      ((render-call (cons (quote render-to-html) (cons comp (emit-kw-pairs kwargs)))))
                      (if
                        pos
                        (list
                          (quote hs-put!)
                          render-call
                          pos
                          (if target target (quote me)))
                        render-call)))))
              ((= head (quote not-in?))
                (list
                  (quote not)
                  (list
                    (quote hs-contains?)
                    (hs-to-sx (nth ast 2))
                    (hs-to-sx (nth ast 1)))))
              ((= head (quote in?))
                (list
                  (quote hs-contains?)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 1))))
              ((= head (quote type-check))
                (list
                  (quote hs-type-check)
                  (hs-to-sx (nth ast 1))
                  (nth ast 2)))
              ((= head (quote type-check-strict))
                (list
                  (quote hs-type-check-strict)
                  (hs-to-sx (nth ast 1))
                  (nth ast 2)))
              ((= head (quote strict-eq))
                (list
                  (quote hs-strict-eq)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote eq-ignore-case))
                (list
                  (quote hs-eq-ignore-case)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote some))
                (list
                  (quote some)
                  (list
                    (quote fn)
                    (list (make-symbol (nth ast 1)))
                    (hs-to-sx (nth ast 3)))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote every))
                (list
                  (quote every?)
                  (list
                    (quote fn)
                    (list (make-symbol (nth ast 1)))
                    (hs-to-sx (nth ast 3)))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote scroll!))
                (list
                  (quote hs-scroll!)
                  (hs-to-sx (nth ast 1))
                  (nth ast 2)))
              ((= head (quote select!))
                (list (quote hs-select!) (hs-to-sx (nth ast 1))))
              ((= head (quote reset!))
                (list (quote hs-reset!) (hs-to-sx (nth ast 1))))
              ((= head (quote default!))
                (let
                  ((t (hs-to-sx (nth ast 1))) (v (hs-to-sx (nth ast 2))))
                  (list
                    (quote when)
                    (list (quote nil?) t)
                    (list (quote set!) t v))))
              ((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
              ((= head (quote focus!))
                (list (quote dom-focus) (hs-to-sx (nth ast 1))))
              (true ast))))))))

;; ── Convenience: source → SX ─────────────────────────────────
(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src))))