Clojure 中用于模式匹配的点对的类似物

Question

方案（和 CL）具有点对，其中 cons 单元格的两个元素均显式指定（例如 (1 . 2)），而不是隐式指定（例如 ( 1 2) 读作 (1 . (2 . nil)))。

我遇到了这个谜题，其中点对用于模式匹配捕获正在匹配的对象中列表的尾部，例如：

(pmatch '(foo . (? pvar)) '(foo bar baz))
;;      => ((pvar bar baz))

这里 '(foo . (? pvar)) 是一个模式，'(foo bar baz) 是匹配的对象模式。模式中的 foo 是一个文字，而 (? pvar) 是一个模式变量，它匹配 (bar baz) 并绑定符号 pvar 到那场比赛。 pmatch 函数返回模式变量和绑定匹配的关联列表。

如果模式是 '(foo (? pvar))，则匹配将会失败，因为 baz 不会匹配模式中的任何内容。

我已经在 Clojure 中实现了这个难题，并且通过了除点对测试用例之外的所有 JRM 测试用例。我正在尝试找出如何支持点对模式。

这是我当前的解决方案：

(defn pattern-variable? [pv]
  (when (seq? pv)
    (let [[qmark var] pv]
     (and (= (count pv) 2)
          (= qmark '?)
          (or (symbol? var)
              (keyword? var)))))

(defn pattern-variable [pv]
  (second pv))

(defn pmatch
  ([pat obj] (pmatch pat obj {}))
  ([pat obj binds]
     (cond (not (coll? pat))
           (when (= pat obj) binds)
           (pattern-variable? pat)
           (assoc binds (pattern-variable pat) obj)
           (seq? pat) (let [[pat-f & pat-r] pat]
                      (when (seq? obj)
                        (when-let [binds (pmatch pat-f (first obj) binds)]
                          (pmatch pat-r (next obj) binds))))
           :else nil)))

那么如何支持与 Clojure 中的对象的其余部分匹配而无需点对的模式呢？

Answer 1

（编辑：添加了一个稍长但明显更清晰的匹配器 impl + 演示。原始版本仍然低于水平规则。）

一种解决方案是引入不同的符号来表示要匹配的变量seq 的尾部，或“点后变量”。另一种方法是将 & 保留为模式中的特殊符号，要求它后面只能跟一个与表达式/对象的其余部分相匹配的单个模式变量，该变量必须是一个序列。我将在下面探讨第一种方法。

在这里，我擅自更改了符号，使 ~foo 是变量 foo 的常规出现，而 ~@foo 是尾部出现。 （可以允许 ~@ 与子序列匹配，也许匹配序列的最小初始片段（如果有的话），以便剩余部分可以与模式的其余部分匹配；我只想说不过，这超出了这个答案的范围；-))

请注意，这些实际上是同一变量的不同出现 - 即仍然只有一种变量类型 - 因为 ~-出现和由 ~@ 出现引起的绑定。

另请注意，您链接到的帖子中的示例不会测试重新绑定先前绑定的变量的尝试（例如尝试 (pmatch '(~x ~x) '(foo bar)), (pmatch '((? x) (? x)) '(foo bar)) 在原始语法中）。在这种情况下，下面的代码将返回 nil，就像当匹配由于其他原因失败时一样。

首先，一个演示：

user> (pmatch '(foo ~pvar1 ~pvar2 bar) '(foo 33 (xyzzy false) bar))
{pvar2 (xyzzy false), pvar1 33}
user> (pmatch '(~av ~@sv) '(foo bar baz))
{sv (bar baz), av foo}
user> (pmatch '(foo ~pvar1 ~pvar2 bar) '(foo 33 false bar))
{pvar2 false, pvar1 33}
user> (pmatch '(foo ~pvar bar) '(quux 33 bar))
nil
user> (pmatch '(a ~var1 (nested (c ~var2))) '(a b (nested (c d))))
{var2 d, var1 b}
user> (pmatch '(a b c) '(a b c))
{}
user> (pmatch '(foo ~pvar1 ~pvar2 bar) '(foo 33 (xyzzy false) bar))
{pvar2 (xyzzy false), pvar1 33}
user> (pmatch '(foo ~@pvar) '(foo bar baz))
{pvar (bar baz)}
user> (pmatch '(~? quux) '(foo quux))
{? foo}
user> (pmatch '~? '(foo quux))
{? (foo quux)}
user> (pmatch '(? ? ?) '(foo quux))
nil

这是匹配器：

(defn var-type [pat]
  (when (seq? pat)
    (condp = (first pat)
      'clojure.core/unquote :atomic
      'clojure.core/unquote-splicing :sequential
      nil)))

(defn var-name [v]
  (when (var-type v)
    (second v)))

(defmulti pmatch*
  (fn [pat expr bs]
    (cond
      (= :atomic (var-type pat))        :atom
      (= :sequential (var-type pat))    nil
      (and (seq? pat) (seq? expr))      :walk
      (not (or (seq? pat) (seq? expr))) :exact
      :else                             nil)))

(defmethod pmatch* :exact [pat expr bs]
  (when (= pat expr) bs))

(defmethod pmatch* :atom [v expr bs]
  (if-let [[_ x] (find bs (var-name v))]
    (when (= x expr) bs)
    (assoc bs (var-name v) expr)))

(defmethod pmatch* :walk [pat expr bs]
  (if-let [[p] pat]
    (if (= :sequential (var-type p))
      (when (and (seq? expr) (not (next pat)))
        (if-let [[_ xs] (find bs (var-name p))]
          (when (= xs expr) bs)
          (assoc bs (var-name p) expr)))
      (when-let [[x] expr]
        (when-let [m (pmatch* p x bs)]
          (pmatch* (next pat) (next expr) m))))))

(defmethod pmatch* nil [& _] nil)

(defn pmatch
  ([pat expr] (pmatch pat expr {}))
  ([pat expr bs] (pmatch* pat expr bs)))

---

这是原始的整体版本：

(defn pmatch
  ([pat expr] (pmatch pat expr {}))
  ([pat expr bs]
     (letfn [(atom-var? [pat]
               (and (seq? pat) (= 'clojure.core/unquote (first pat))))
             (seq-var? [pat]
               (and (seq? pat) (= 'clojure.core/unquote-splicing
                                  (first pat))))
             (v [var] (second var))
             (matcha [a e bs]
               (if-let [[_ x] (find bs (v a))]
                 (and (or (= x e) nil) bs)
                 (assoc bs (v a) e)))
             (matchs [s e bs]
               (when (seq? e)
                 (if-let [[_ xs] (find bs (v s))]
                   (or (= xs e) nil)
                   (assoc bs (v s) e))))]
       (when bs
         (cond
           (atom-var? pat)
           (matcha pat expr bs)

           (seq-var? pat)
           (matchs pat expr bs)

           (and (seq? pat) (seq? expr))
           (if-let [[p] pat]
             (if (seq-var? p)
               (matchs p expr bs)
               (when-let [[x] expr]
                 (when-let [m (pmatch p x bs)]
                   (recur (next pat) (next expr) m))))
             (when-not (first expr)
               bs))

           (not (or (seq? pat) (seq? expr)))
           (when (= pat expr)
             bs)

           :else nil)))))