(Правка: добавлено немного более длинное, но значительно более четкое совпадение импл + демо. Оригинал остается ниже горизонтального правила.)
Одним из решений было бы введение другой нотациидля обозначения переменной, которая должна быть сопоставлена с хвостом последовательности, или «переменная после точки».Другим вариантом было бы зарезервировать & в качестве специального символа в шаблонах с требованием, чтобы за ним следовала только одна переменная шаблона для сопоставления с остальной частью выражения / объекта, которая должна быть последовательностью.Я расскажу о первом подходе ниже.
Здесь я позволил себе сменить нотацию так, чтобы ~foo - это регулярное вхождение переменной foo, а ~@foo - вхождение в хвост.(Можно разрешить сопоставление ~@ с подпоследовательностями, возможно, сопоставить минимальный начальный фрагмент последовательности, если таковой имеется, так, чтобы остаток можно было сопоставить с остальной частью шаблона; я просто скажу, что это выходит за рамкиэтот ответ, однако.; -))
Обратите внимание, что на самом деле это разные вхождения одной и той же переменной, т. е. существует только один тип переменной, поскольку не делается различий между привязками, возникающими из ~ -occurrence и bindings, возникающие из ~@ -occururrence.
Также обратите внимание, что примеры в посте, на который вы ссылались, не проверяют попытки повторно связать ранее связанную переменную (например, 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)))))