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

liw*_*iwp 2 clojure pattern-matching

Scheme(和CL)具有点对,其中单元的两个元素cons被明确地(例如(1 . 2))指定而不是隐式指定(例如(1 2),其被读取为(1 . (2 . nil))).

我遇到了这个难题,其中点对用于模式匹配,以捕获匹配对象中列表的尾部,例如:

(pmatch '(foo . (? pvar)) '(foo bar baz))
;;      => ((pvar bar baz))
Run Code Online (Sandbox Code Playgroud)

'(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)))
Run Code Online (Sandbox Code Playgroud)

那么如何在没有点对的情况下支持与Clojure中其余对象匹配的模式?

Mic*_*zyk 6

(编辑:添加了稍长但更清晰的匹配器impl +演示.原始版本仍然低于水平线.)

一种解决方案是引入不同的符号来表示要与seq的尾部匹配的变量,或"点后变量".另一种方法是&在模式中保留作为特殊符号,要求它只能跟随单个模式变量,以匹配表达式/对象的其余部分,它必须是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
Run Code Online (Sandbox Code Playgroud)

这是匹配器:

(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)))
Run Code Online (Sandbox Code Playgroud)

这是最初的单片版本:

(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)))))
Run Code Online (Sandbox Code Playgroud)