OMGWTFBBQ

OMGWTFBBQ

(defprotocol Foo (one [this])
                 (two [this arg]))

(def echo-foo
  (reify
    Foo
    (one [this] "test")
    (two [this arg] arg)))

(defn delegating-s-expression [this-symbol sig arglist]
  (let [arg-syms (map (comp gensym str) arglist)]
    (map (fn [arglist] `(~(:name sig) [~@arg-syms] (~(:name sig) ~this-symbol ~@(drop 1 arg-syms)))) (:arglists sig))))

(defn delegating-s-expressions-for-arglists [this-symbol sig]
  (mapcat (partial delegating-s-expression this-symbol sig) (:arglists sig)))

(defn delegate-s-expressions [protocol instance-symbol]
  (mapcat (partial delegating-s-expressions-for-arglists instance-symbol) (vals (:sigs protocol))))

(defn symbol+arg-count
  [s-expression]
  [(name (first s-expression)) (count (second s-expression))])

(defn overload-for [overloads method]
  (let [method-sig (symbol+arg-count method)]
    (first (filter (fn [overload]  (= (symbol+arg-count overload) method-sig)) overloads))))

(defn replace-sigs [sigs & overloads]
  (map (fn [sig] (or (overload-for overloads sig) sig)) sigs))

(def magic (eval `(reify Foo ~@(replace-sigs (delegate-s-expressions Foo 'echo-foo) `(one [this#] "overloaded")))))

(println (one magic))

(println (two magic "Original method"))