;; _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))
              (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?)
                (cond
                  ((<= (len items) 1)
                    (let
                      ((body (if (> (len items) 0) (first items) nil)))
                      (let
                        ((target (if source (hs-to-sx source) (quote me))))
                        (let
                          ((handler (list (quote fn) (list (quote event)) (hs-to-sx 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?))
                  ((= (first items) :filter)
                    (scan-on
                      (rest (rest items))
                      source
                      (nth items 1)
                      every?))
                  ((= (first items) :every)
                    (scan-on (rest (rest items)) source filter true))
                  (true (scan-on (rest items) source filter every?)))))
            (scan-on (rest parts) nil nil false)))))
    (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 (nth ast 1)) (value (hs-to-sx (nth ast 2))))
          (if
            (= (len ast) 5)
            (list
              (quote hs-transition)
              (hs-to-sx (nth ast 4))
              prop
              value
              (nth ast 3))
            (list
              (quote hs-transition)
              (hs-to-sx (nth ast 3))
              prop
              value
              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
        (target)
        (let
          ((t (hs-to-sx target)))
          (if
            (and (list? target) (= (first target) (quote attr)))
            (list
              (quote dom-set-attr)
              (hs-to-sx (nth target 2))
              (nth target 1)
              (list
                (quote +)
                (list
                  (quote dom-get-attr)
                  (hs-to-sx (nth target 2))
                  (nth target 1))
                1))
            (list (quote set!) t (list (quote +) t 1))))))
    (define
      emit-dec
      (fn
        (target)
        (let
          ((t (hs-to-sx target)))
          (if
            (and (list? target) (= (first target) (quote attr)))
            (list
              (quote dom-set-attr)
              (hs-to-sx (nth target 2))
              (nth target 1)
              (list
                (quote -)
                (list
                  (quote dom-get-attr)
                  (hs-to-sx (nth target 2))
                  (nth target 1))
                1))
            (list (quote set!) t (list (quote -) t 1))))))
    (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 me)) (quote me))
              ((= head (quote it)) (quote it))
              ((= head (quote event)) (quote event))
              ((= head dot-sym)
                (list (quote get) (hs-to-sx (nth ast 1)) (nth ast 2)))
              ((= head (quote ref)) (make-symbol (nth ast 1)))
              ((= head (quote query))
                (list (quote dom-query) (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 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 not) (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-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)
                (list
                  pct-sym
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote empty?))
                (list (quote 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?))
                (list
                  (quote dom-matches?)
                  (hs-to-sx (nth ast 1))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote contains?))
                (list
                  (quote contains?)
                  (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 contains?)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 1))))
              ((= head (quote of))
                (list
                  (quote get)
                  (hs-to-sx (nth ast 2))
                  (hs-to-sx (nth ast 1))))
              ((= 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))
                (list
                  (quote dom-add-class)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= head (quote remove-class))
                (list
                  (quote dom-remove-class)
                  (hs-to-sx (nth ast 2))
                  (nth ast 1)))
              ((= 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 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 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))
                (list
                  (quote dom-set-style)
                  (hs-to-sx (nth ast 1))
                  "display"
                  "none"))
              ((= head (quote show))
                (list
                  (quote dom-set-style)
                  (hs-to-sx (nth ast 1))
                  "display"
                  ""))
              ((= head (quote transition)) (emit-transition ast))
              ((= head (quote repeat)) (emit-repeat ast))
              ((= head (quote fetch))
                (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
              ((= head (quote call))
                (cons
                  (make-symbol (nth ast 1))
                  (map hs-to-sx (rest (rest ast)))))
              ((= 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))
                (list
                  (quote let)
                  (list (list (quote me) (hs-to-sx (nth ast 1))))
                  (hs-to-sx (nth ast 2))))
              ((= head (quote for)) (emit-for ast))
              ((= head (quote take))
                (list (quote hs-take!) (hs-to-sx (nth ast 2)) (nth ast 1)))
              ((= 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)))
              ((= head (quote decrement!)) (emit-dec (nth ast 1)))
              ((= 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))
              (true ast))))))))

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