Test if patterns from unrelated queries can match

matching.clj

(defn v? [x] (and (symbol? x) (= \? (first (name x)))))

(defn bnd-for [bindings other-bindings k]
  (if-let [v (bindings k)]
    (loop [b1 bindings, b2 other-bindings, cv v, subv (other-bindings v)]
      (if-not subv
        cv
        (recur b2 b1 subv (b1 subv))))))

(defn compatible? [x y]
  (or (v? x) (v? y) (= x y)))

(defn matches? [a b]
  {:pre [(= 3 (count a))]}
  (loop [b-left {} b-right {} [af & ar] a [bf & br] b]
    (or
      (or (nil? af) (nil? bf))  ;; finished
      (if (v? af)
        (let [y (bnd-for b-right b-left bf)]
          (if-let [x (bnd-for b-left b-right af)]
            (and (compatible? x (or y bf))
                 (let [[new-left-bind new-right-bind] (if (v? x)
                                                        [(assoc b-left x (or y bf)) b-right]
                                                        (if (v? y)
                                                          [b-left (assoc b-right y x)]
                                                          (if (and (v? bf) (nil? y))
                                                            [b-left (assoc b-right bf x)]
                                                            [b-left b-right])))]
                   (recur new-left-bind new-right-bind ar br)))
            (and (compatible? af (or y bf))
                 (recur (assoc b-left af (or y bf)) b-right ar br))))
        (if (v? bf)
          (if-let [y (bnd-for b-right b-left bf)]
            (and (compatible? y af)
                 (let [new-right-bind (if (v? y)
                                        (assoc b-right y af)
                                        b-right)]
                   (recur b-left new-right-bind ar br)))
            (and (compatible? bf af)
                 (recur b-left (assoc b-right bf af) ar br)))
          (and (= af bf)
               (recur b-left b-right ar br)))))))