(ns unhygienic
  (:require [clojure.core.match :refer [match]]
            [clojure.spec.alpha :as s]
            [expand]))

(defn- merge-unify-with
  ([f] {})
  ([f a] a)
  ([f a b] (and a b (merge-with f a b)))
  ([f a b & xs] (reduce #(merge-unify-with f %1 %2) (cons a (cons b xs)))))

(defn- merge-unify [& xs]
  (apply merge-unify-with (fn [_ x] x) xs))

(defn- unify* [pattern datum]
  (match [pattern datum]
    [[:wildcard _] _] {}
    [[:var x] _] {x datum}
    
    [[:list {:leading leading
             :trailing nil
             :ellipsis ellipsis}]
     (_ :guard seq?)]
    (let [[leading-datum ellipsis-datum] (split-at (count leading) datum)]
      (merge-unify
       (apply merge-unify (map #(unify* %1 %2)
                               leading
                               leading-datum))
       (some->> ellipsis-datum
                (map #(when-some [r (unify* ellipsis %)]
                        (->> r
                             (map (fn [[k v]] [k (list v)]))
                             (into {}))))
                (apply merge-unify-with concat)
                (map (fn [[k v]]
                       [k [:ellipsis v]]))
                (into {}))))

    [[:list {:leading leading}]
     (_ :guard seq?)]
    (when (= (count datum)
             (count leading))
      (->> (map #(unify* %1 %2) leading datum)
           (apply merge-unify)))

    ;; no match
    :else nil))

(defn unify [pattern datum]
  (unify* (s/conform :expand/pattern pattern) datum))



(comment
  (transcribe (unify '((a ...) ...)
                     '((1 2) (3 4) (5 6)))
              '(begin (a ...) ...))
  (strip-ellipsis
   '[:ellipsis ([:ellipsis (1 2)] [:ellipsis (3 4)] [:ellipsis (5 6)])]
   2))

(defn- strip-ellipsis [unif ellipsis-depth]
  (match unif
    [:ellipsis p]
    (if (< 0 ellipsis-depth)
      (map #(strip-ellipsis % (dec ellipsis-depth)) p)
      (throw (ex-info "나쁜 점점점" {})))
    :else unif))

(defn- transcribe*
  ([unification template]
   (transcribe* 0 unification template))
  ([ellipsis-depth unification template]
   (match template
     [:lit l] l

     [:var x]
     (match (get unification x)
       ([:ellipsis _] :as p)
       (strip-ellipsis p ellipsis-depth)

       ;; unhygenic but it's demo }:)
       (_ :guard nil?) x

       p p)

     [:list ts]
     (->> (for [t ts]
            (match t
              [:ellipsis t*] (transcribe* (inc ellipsis-depth) unification t*)
              :else [(transcribe* ellipsis-depth unification t)]))
          (apply concat)))))

(defn transcribe [unification template]
  (transcribe* 0 unification (s/conform :expand/template template)))

(comment
  (transcribe-transformer scheme-and '(and 1 2)))

(defn transcribe-transformer [trans datum]
  (some (fn [{:keys [pattern template]}]
          (when-some [unification (unify* pattern datum)]
            (let [r (transcribe* unification template)]
              (assert r)
              r)))
        (:rules trans)))