;; lib/minikanren/matche.sx — Phase 5 piece D: pattern matching over terms.
;;
;;   (matche TARGET
;;     (PATTERN1 g1 g2 ...)
;;     (PATTERN2 g1 ...)
;;     ...)
;;
;; Pattern grammar:
;;   _                 wildcard — fresh anonymous var
;;   x                 plain symbol — fresh var, bind by name
;;   ATOM              literal (number, string, boolean) — must equal
;;   :keyword          keyword literal — emitted bare (keywords self-evaluate
;;                     to their string name in SX, so quoting them changes
;;                     their type from string to keyword)
;;   ()                empty list — must equal
;;   (p1 p2 ... pn)    list pattern — recurse on each element
;;
;; The macro expands to a `conde` whose clauses are
;;   `((fresh (vars-in-pat) (== target pat-expr) body...))`.
;;
;; Repeated symbol names within a pattern produce the same fresh var, so
;; they unify by `==`. Fixed-length list patterns only — head/tail
;; destructuring uses `(fresh (a d) (conso a d target) body)` directly.
;;
;; Note: the macro builds the expansion via `cons` / `list` rather than a
;; quasiquote — quasiquote does not recurse into nested lambda bodies in
;; SX, so `\`(matche-clause (quote ,target) cl)` left literal
;; `(unquote target)` in the output.

(define matche-symbol-var? (fn (s) (symbol? s)))

(define
  matche-collect-vars-acc
  (fn
    (pat acc)
    (cond
      ((matche-symbol-var? pat)
        (if (some (fn (s) (= s pat)) acc) acc (append acc (list pat))))
      ((and (list? pat) (not (empty? pat)))
        (reduce (fn (a p) (matche-collect-vars-acc p a)) acc pat))
      (:else acc))))

(define
  matche-collect-vars
  (fn (pat) (matche-collect-vars-acc pat (list))))

(define
  matche-pattern->expr
  (fn
    (pat)
    (cond
      ((matche-symbol-var? pat) pat)
      ((and (list? pat) (empty? pat)) (list (quote list)))
      ((list? pat) (cons (quote list) (map matche-pattern->expr pat)))
      ((keyword? pat) pat)
      (:else (list (quote quote) pat)))))

(define
  matche-clause
  (fn
    (target cl)
    (let
      ((pat (first cl)) (body (rest cl)))
      (let
        ((vars (matche-collect-vars pat)))
        (let
          ((pat-expr (matche-pattern->expr pat)))
          (list
            (cons
              (quote fresh)
              (cons vars (cons (list (quote ==) target pat-expr) body)))))))))

(defmacro
  matche
  (target &rest clauses)
  (cons (quote conde) (map (fn (cl) (matche-clause target cl)) clauses)))