Clojure中用于模式匹配的点对模拟

方案（和CL）有点对，其中

cons

单元格的两个元素都是显式指定的（例如

（1.2）

），而不是隐式指定的（例如

（12）

，读作

（1.（2.nil））

）

我遇到过这样的情况，在模式匹配中使用点对来捕获被匹配对象中列表的尾部，例如：

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

这里的

'（foo.（？pvar））

是一个模式，而

'（foo-bar-baz）

是与该模式匹配的对象<模式中的code>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中匹配对象其余部分的模式，而不使用虚线对呢？

（编辑：添加了稍长但明显更清晰的matcher impl+演示。原始模式仍低于水平规则。）

一种解决方案是引入不同的符号来表示要与seq尾部匹配的变量，或“点后变量”。另一种方法是将

&

保留为模式中的特殊符号，要求它后面只能跟一个模式变量，以便与表达式/对象的其余部分（必须是seq）匹配。我将在下面探讨第一种方法

在这里，我随意更改了符号，使

~foo

是变量

foo

的常规出现，而

~@foo

是尾部出现。（可以允许对子序列进行

~@

-匹配，可能匹配序列的最小初始片段（如果有的话），这样剩余部分就可以与模式的其余部分进行匹配；不过，我只能说这超出了这个答案的范围。；-）

请注意，这实际上是同一个变量的不同实例，即仍然只有一种变量类型，因为在

~

-实例产生的绑定和

~@

-实例产生的绑定之间没有区别

还要注意的是，您链接到的帖子中的示例没有测试是否尝试重新绑定以前绑定的变量（例如，在原始语法中，try

（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)))))

---

干得好！多方法无疑使代码更清晰。我认为在

pmatch*

：walk

中有一个bug，您正在查找相同模式变量的以前的绑定：

（if let[[\uxs]（find bs（var name bs））]

应该是

（if let[[uxs]（find bs（var name p））]

。另外，在写问题时，我考虑使用

或

&

作为分隔符，分隔符后的模式变量将匹配对象的尾部。但是我肯定更喜欢你使用

~

和

~@

。我担心的另一件事是我必须检查patt对于语法错误，例如，

（foo.（？var）bar）

应该是非法的，我认为这在您的解决方案中也是一个问题，而在Scheme中，读者会注意到这一点。啊，很好地理解了

：walk

，修复了。另外，同意了

（foo.（？var）bar）

样式模式；我添加了一个额外的签入

：walk

，以使与此类模式的匹配总是失败。