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中其余对象匹配的模式?
(编辑:添加了稍长但更清晰的匹配器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)