20 Days of Clojure: Day 19

Ok, yesterday I decided to try to implement a defclass macro which would hobble multimethods and force you to have some kind of class inheritance for polymorphism. Today, I’ll try to implement that macro.

First, I made this macro, which I think will be useful

  (defmacro sym2key [s]
    `(keyword (name (quote ~s)))    
  )

Works like this:

  user=> (sym2key rect)
  :rect

(I wrote the above this morning, and after several hours, I didn’t get too far)

I had to cheat a lot, but I finally got something — here is my final OO minilanguage

  (defclass shape
    (defabstractmeth area)
  )
  (defclass rect
    (defctor (fn [w h] (setprop w) (setprop h) ))
    (defmeth area (fn [] (* (:w this) (:h this))))
  )
  (defclass circle
    (defctor (fn [r] (setprop r) ))
    (defmeth area (fn [] (* (:r this) (:r this) (. Math PI))))
  )

I got that to be processed by these macros:

  (defmacro sym2key [s]
    `(keyword (name (quote ~s)))  
  )

  (defmacro defclass [name & body]
    (cons ‘do
    (loop [classbody# body parts# nil]
      (if classbody#
        (recur (rest classbody#) (cons (concat (first classbody#) `(~name)) parts#))
        parts#)))
      
  )

  (defmacro defabstractmeth [name class] `(defmulti ~name :type) )

  (defmacro setprop [x] { (sym2key x) x })

  (defmacro defctor [fndef name]
    (let [  arglist# (second fndef)
        fnbody# (map second (nthrest fndef 2) )
        obj# (reduce merge
            {:type `(sym2key ~name)}
            (map assoc (repeat {})
              (map eval
                (map sym2key fnbody#)) fnbody#))
      ]
      
      `(defn ~name ~arglist# ~obj#)
    )
  )

  (defmacro defmeth [meth fndef name]
    (let [  arglist# (conj (second fndef) 'this)
        fnbody# (first (nthrest fndef 2))
        namesym# (eval `(sym2key ~name))

      ]
      
      `(defmethod ~meth ~namesym# ~arglist# ~fnbody#)
    )
  )

This code shows it in action:

  (prn (rect 10 20))
  (prn (area (rect 10 20)))
  (prn (circle 10))
  (prn (area (circle 10)))

Outputs:

  {:type :rect, :h 20, :w 10}
  200
  {:type :circle, :r 10}
  314.1592653589793

I am way too tired to explain this — suffice to say, this is kind a crazy way to make something, but it sure beats not being able to make it. My ctor implementation is so crazy, that you should just ignore it — defclass and defmeth are worth looking at (ctor is a major hack — assumes only setprop calls and turns them into a map).