Быстрые пути существуют по определенной причине, но Clojure не мешает вам делать все, что вы хотите, скажем, включая специальную рассылку предикатов. Мир определенно твоя устрица. Обратите внимание на этот супер быстрый и грязный пример ниже.
Сначала мы начнем с атома, чтобы хранить все наши полиморфные функции:
(def polies (atom {}))
При использовании внутренняя структура polies будет выглядеть примерно так:
{foo ; <- function name
{:dispatch [[pred0 fn0 1 ()] ; <- if (pred0 args) do (fn0 args)
[pred1 fn1 1 ()]
[pred2 fn2 2 '&]]
:prefer {:this-pred #{:that-pred :other-pred}}}
bar
{:dispatch [[pred0 fn0 1 ()]
[pred1 fn1 3 ()]]
:prefer {:some-pred #{:any-pred}}}}
Теперь давайте сделаем так, чтобы мы могли prefer предикаты (например, prefer-method):
(defn- get-parent [pfn x] (->> (parents x) (filter pfn) first))
(defn- in-this-or-parent-prefs? [poly v1 v2 f1 f2]
(if-let [p (-> @polies (get-in [poly :prefer v1]))]
(or (contains? p v2) (get-parent f1 v2) (get-parent f2 v1))))
(defn- default-sort [v1 v2]
(if (= v1 :poly/default)
1
(if (= v2 :poly/default)
-1
0)))
(defn- pref [poly v1 v2]
(if (-> poly (in-this-or-parent-prefs? v1 v2 #(pref poly v1 %) #(pref poly % v2)))
-1
(default-sort v1 v2)))
(defn- sort-disp [poly]
(swap! polies update-in [poly :dispatch] #(->> % (sort-by first (partial pref poly)) vec)))
(defn prefer [poly v1 v2]
(swap! polies update-in [poly :prefer v1] #(-> % (or #{}) (conj v2)))
(sort-disp poly)
nil)
Теперь давайте создадим нашу систему поиска отправки:
(defn- get-disp [poly filter-fn]
(-> @polies (get-in [poly :dispatch]) (->> (filter filter-fn)) first))
(defn- pred->disp [poly pred]
(get-disp poly #(-> % first (= pred))))
(defn- pred->poly-fn [poly pred]
(-> poly (pred->disp pred) second))
(defn- check-args-length [disp args]
((if (= '& (-> disp (nth 3) first)) >= =) (count args) (nth disp 2)))
(defn- args-are? [disp args]
(or (isa? (vec args) (first disp)) (isa? (mapv class args) (first disp))))
(defn- check-dispatch-on-args [disp args]
(if (-> disp first vector?)
(-> disp (args-are? args))
(-> disp first (apply args))))
(defn- disp*args? [disp args]
(and (check-args-length disp args)
(check-dispatch-on-args disp args)))
(defn- args->poly-fn [poly args]
(-> poly (get-disp #(disp*args? % args)) second))
Далее, давайте подготовим наш макрос определения с некоторыми функциями инициализации и настройки:
(defn- poly-impl [poly args]
(if-let [poly-fn (-> poly (args->poly-fn args))]
(-> poly-fn (apply args))
(if-let [default-poly-fn (-> poly (pred->poly-fn :poly/default))]
(-> default-poly-fn (apply args))
(throw (ex-info (str "No poly for " poly " with " args) {})))))
(defn- remove-disp [poly pred]
(when-let [disp (pred->disp poly pred)]
(swap! polies update-in [poly :dispatch] #(->> % (remove #{disp}) vec))))
(defn- til& [args]
(count (take-while (partial not= '&) args)))
(defn- add-disp [poly poly-fn pred params]
(swap! polies update-in [poly :dispatch]
#(-> % (or []) (conj [pred poly-fn (til& params) (filter #{'&} params)]))))
(defn- setup-poly [poly poly-fn pred params]
(remove-disp poly pred)
(add-disp poly poly-fn pred params)
(sort-disp poly))
С этим мы наконец можем построить наши polies, потерев туда немного сока макроса:
(defmacro defpoly [poly-name pred params body]
`(do (when-not (-> ~poly-name quote resolve bound?)
(defn ~poly-name [& args#] (poly-impl ~poly-name args#)))
(let [poly-fn# (fn ~(symbol (str poly-name "-poly")) ~params ~body)]
(setup-poly ~poly-name poly-fn# ~pred (quote ~params)))
~poly-name))
Теперь вы можете построить произвольную предикатную диспетчеризацию:
;; use defpoly like defmethod, but without a defmulti declaration
;; unlike defmethods, all params are passed to defpoly's predicate function
(defpoly myinc number? [x] (inc x))
(myinc 1)
;#_=> 2
(myinc "1")
;#_=> Execution error (ExceptionInfo) at user$poly_impl/invokeStatic (REPL:6).
;No poly for user$eval187$myinc__188@5c8eee0f with ("1")
(defpoly myinc :poly/default [x] (inc x))
(myinc "1")
;#_=> Execution error (ClassCastException) at user$eval245$fn__246/invoke (REPL:1).
;java.lang.String cannot be cast to java.lang.Number
(defpoly myinc string? [x] (inc (read-string x)))
(myinc "1")
;#_=> 2
(defpoly myinc
#(and (number? %1) (number? %2) (->> %& (filter (complement number?)) empty?))
[x y & z]
(inc (apply + x y z)))
(myinc 1 2 3)
;#_=> 7
(myinc 1 2 3 "4")
;#_=> Execution error (ArityException) at user$poly_impl/invokeStatic (REPL:5).
;Wrong number of args (4) passed to: user/eval523/fn--524
; ^ took the :poly/default path
А при использовании вашего примера мы видим:
(defn new-bacterium [starting-position]
{:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
(defpoly take-turn (fn [b _] (-> b keys set (contains? :direction)))
[this world]
(println "Directed turn!"))
;; or, if you'd rather use spec
(defpoly take-turn (fn [b _] (->> b (s/valid? (s/keys :req-un [::direction])))
[this world]
(println "Directed turn!"))
(take-turn (new-directed-bacterium [0 0] nil) nil)
;#_=> Directed turn!
;nil
(defpoly take-turn :poly/default [this world]
(println "Aimless turn!"))
(take-turn (new-bacterium [0 0]) nil)
;#_=> Aimless turn!
;nil
(defpoly take-turn #(-> %& first :show) [this world]
(println :this this :world world))
(take-turn (assoc (new-bacterium [0 0]) :show true) nil)
;#_=> :this {:mass 0, :position [0 0], :show true} :world nil
;nil
Теперь, давайте попробуем использовать isa? отношения, а-ля defmulti:
(derive java.util.Map ::collection)
(derive java.util.Collection ::collection)
;; always wrap classes in a vector to dispatch off of isa? relationships
(defpoly foo [::collection] [c] :a-collection)
(defpoly foo [String] [s] :a-string)
(foo [])
;#_=> :a-collection
(foo "bob")
;#_=> :a-string
И, конечно, мы можем использовать prefer для устранения неоднозначности отношений:
(derive ::rect ::shape)
(defpoly bar [::rect ::shape] [x y] :rect-shape)
(defpoly bar [::shape ::rect] [x y] :shape-rect)
(bar ::rect ::rect)
;#_=> :rect-shape
(prefer bar [::shape ::rect] [::rect ::shape])
(bar ::rect ::rect)
;#_=> :shape-rect
Опять мир, твоя устрица! Ничто не мешает вам расширять язык в любом направлении.