dag.clj

(defprotocol I
  (x [this])
  (y [this]))

(defprotocol IClass
  (id [this]))

(deftype A [x y] I (x [_] x) (y [_] y))
(deftype B [x y] I (x [_] x) (y [_] y))
(deftype C [x y] I (x [_] x) (y [_] y))
(deftype D [x y] I (x [_] x) (y [_] y))

(extend-type A IClass (id [_] 0))
(extend-type B IClass (id [_] 1))
(extend-type C IClass (id [_] 2))
(extend-type D IClass (id [_] 3))

(defn dag [f1 f2]
  (case (id f1)
        0 (case (id (x f1))
                0 (case (= (y f1) (y f2))
                        true :m1
                        false :m-not-understood)
                1 :m-not-understood
                2 :m-not-understood
                3 (case (= (y f1) (y f2))
                        true :m1
                        false :m-not-understood))
        1 (case (id (x f1)) 
                0 (case (= (y f1) (y f2))
                        true :m1
                        false :m-not-understood)
                1 :m2
                2 :m-not-understood
                3 (case (= (y f1) (y f2))
                        true :m1
                        false :m-not-understood))
        2 (case (id f2)
                0 (case (id (x f1))
                        1 :m2
                        0 :m4
                        2 :m4
                        3 :m4)
                1 (case (id (x f1))
                        1 :m2
                        0 :m4
                        2 :m4
                        3 :m4)
                2 :m3
                3 :m-ambiguous)))

;; ~340-50ms
(let [s1 (B. nil nil)
      o1 (A. (A. nil nil) s1)
      o2 (A. (A. nil nil) s1)]
    (dotimes [_ 10]
      (time
       (dotimes [_ 1e7]
         (dag o1 o2)))))



(defmulti gf (fn [f1 f2]
               [(class f1)
                (class f2)
                (class (x f1))
                (= (y f1) (y f2))]))

(defmethod gf [A Object A true] [f1 f2] :m1)

;; ~1900ms-2000ms
(let [s1 (B. nil nil)
        o1 (A. (A. nil nil) s1)
        o2 (A. (A. nil nil) s1)]
    (dotimes [_ 10]
      (time
       (dotimes [_ 1e7]
         (gf o1 o2)))))