;;;; Classes and generic functions, the dyn side's two dispatch styles.
;;;;
;;;; A defclass is a named dyn map with a shape tag. The constructor is the
;;;; class's own name, positional over the slots; the slots are ordinary map
;;;; keys, so get and put are how one is read and written and nothing new was
;;;; needed for either. What the class adds is the tag, which lives in the
;;;; object's header and not in the entries: (len p) is the slot count, no key
;;;; a program can write collides with it, and it shows up in exactly three
;;;; places -- class-of, equality, and the printed form #point{ :x 1 :y 2}.
;;;;
;;;; The two dispatch styles are one mechanism. A defgeneric dispatches on the
;;;; class of its first argument, which is Common Lisp's; a defmulti's body IS
;;;; the dispatch, which is Clojure's. A class dispatcher is the shape tag of
;;;; the first argument as the dispatch function, so the second spells the
;;;; first, and a method is a branch either way.

(defclass point [x y])
(defclass circle [r])

;; CLOS's half: dispatch on the class of the first argument. The generic
;; declares the parameters and the return type once; a method states neither.
(defgeneric area [self] dyn)

(defmethod area point [p] (* (get p :x) (get p :y)))
;; A method may name its parameter whatever it likes -- the generic's name is
;; bound to it on the way in.
(defmethod area circle [c] (* 3 (* (get c :r) (get c :r))))

;; Clojure's half: the dispatch is a body, over the same parameter list every
;; method has, answering the value the methods are keyed by.
(defmulti describe [thing] dyn (get thing :kind))

(defmethod describe :square [s] (get s :side))
(defmethod describe "round" [s] "a round thing, keyed by a string")
(defmethod describe 7 [s] "the one keyed by a number")
;; The method that answers when no other does. It is :else, which is the word
;; match already uses, and it is the last arm whatever order it is written in.
(defmethod describe :else [s] "something else")

;; A generic with no :else: a miss signals, and the program answers it.
(defgeneric name-of [self] dyn)
(defmethod name-of point [p] "a point")

;; A method's parameter names are its own, and the rebinding that gives it
;; them is parallel. [reorder] names them in the generic's order reversed, which
;; a sequential binding would get wrong in the worst possible way -- it would
;; read the name it had just bound and hand the method its first argument
;; twice. [shift] is the same bug one step shorter: [b] there is the
;; generic's second parameter and must not become the first.
(defmulti reorder [a b] dyn (class-of a))
(defmethod reorder point [b a] [b a])
(defmulti shift [a b] dyn (class-of a))
(defmethod shift point [b c] [b c])

(defn main [] i32
  (let [p (point 3 4)
        c (circle 2)]
    ;; The instance is a map, and prints as one with its tag in front.
    (println p)
    (println (len p))
    (println (get p :x))
    (put p :x 10)
    (println (get p :x))
    (println (has-key? p :x))
    (println (has-key? p :nothing))
    (println (get p :nothing))

    ;; The shape tag, as a value. Every value can be asked; only an instance
    ;; answers with a name.
    (println (class-of p))
    (println (class-of c))
    (println (class-of {:x 3 :y 4}))
    (println (class-of 1))
    (println (class-of nil))

    ;; Equality takes the tag into account: two instances of one class compare
    ;; by their slots, an instance and a plain map with the same entries do
    ;; not, and two classes with the same slots are two classes.
    (println (= (point 1 2) (point 1 2)))
    (println (= (point 1 2) (point 1 3)))
    (println (= (point 1 2) {:x 1 :y 2}))
    (println (= (circle 2) (circle 2)))

    ;; Class dispatch. Same call site, two classes, two methods.
    (println (area p))
    (println (area c))

    ;; Arbitrary dispatch, over three kinds of dispatch value and the
    ;; fallback. The dispatch runs on every call, so the value is whatever
    ;; the map holds at the time.
    (println (describe {:kind :square :side 5}))
    (println (describe {:kind "round"}))
    (println (describe {:kind 7}))
    (println (describe {:kind :hexagon}))
    ;; An empty map on its own is the zero-field struct literal, so it is
    ;; bound first -- the dispatch answers nil for a map with no :kind, and
    ;; nil finds no method either.
    (let [empty {:no :kind}]
      (println (describe empty)))

    ;; An instance is an ordinary dyn value: it goes in a vec, keys a map,
    ;; and is collected like anything else.
    (let [v [p c]]
      (println (len v))
      (println (class-of (at v 1))))

    ;; The renamed parameters, in the generic's own order: the first element
    ;; of each answer is the first argument. A sequential rebinding would
    ;; print the point twice in the first and lose the 99 in the second.
    (println (reorder p 99))
    (println (shift p 99))

    ;; The miss. No method and no :else, so the generic signals NoMethod, and
    ;; handler-case answers the whole form with a value -- the condition
    ;; carries the generic's name and the dispatch value that found nothing.
    (println (name-of p))
    (println
      (handler-case (name-of c)
        [(NoMethod [e] (.generic e))]))
    ;; The condition carries the dispatch value that found nothing, which for
    ;; a defgeneric over a value that is no instance at all is nil.
    (println
      (handler-case (name-of 42)
        [(NoMethod [e] (.value e))])))

  ;; Instances under the collector: enough of them to pass the 1 MiB floor
  ;; many times over, with one live instance in a rooted global. A marker that
  ;; lost an instance's slots would free something live and the sum would come
  ;; out wrong -- the tag itself is an interned keyword and immortal, which is
  ;; why it needs no tracing.
  (let [total (point 0 0)]
    (dotimes [i 50000]
      (let [q (point i "forty-seven bytes of text to fatten each row")]
        (put total :x (+ (get total :x) (len q)))))
    (println (get total :x))
    (println (class-of total)))
  0)