frumiOS – a simple object-system for Clojure

I’ve nearly stopped blogging, because all my spare time goes into writing Clojure in Action. But I was a bit bored this weekend, and wrote this little library that can be used to write traditional looking Object-Oriented (TM) code in Clojure.

Why would you do that, when you can use a rifle-oriented programming style instead? Think of it like using the rifle as a club… On the other had, the implementation makes plenty use of closures and macros, so it is probably a rifle-oriented program :-)

The implementation is hosted on github, in a project called frumios. And if you reall want to see it now, click below.

(ns org.rathore.amit.frumios.core)
 
(declare new-object find-method) 
 
(defn new-class [class-name parent methods]
  (let [klass ((comp resolve symbol name) class-name)]
    (fn [command & args]
      (cond
	(= :parent command) parent
	(= :name command) klass
	(= :method-names command) (keys methods)
	(= :methods command) methods
	(= :new command) (new-object klass)
	(= :method command) 
          (let [[method-name] args]
	    (find-method method-name methods parent))
	:else (throw (RuntimeException. (str "Unknown message: " command)))))))
 
(def OBJECT (new-class :org.rathore.amit.frumios.core/OBJECT nil {}))
(def this)
 
(defn new-object [klass]
  (let [state (ref {})]
    (fn thiz [command & args]
      (cond
        (= :class command) klass
        (= :set! command) (let [[k v] args]
			    (dosync (alter state assoc k v))
			    nil)
        (= :get command) (let [[key] args]
			   (state key))
        :else (let [method (klass :method command)]
		(if method 
		  (binding [this thiz]
		    (apply method args))))))))
 
(defn find-method [method-name instance-methods parent-class]
  (let [method (instance-methods method-name)]
    (or method
	(if-not (= #'org.rathore.amit.frumios.core/OBJECT parent-class)
	  (find-method method-name (parent-class :methods) (parent-class :parent))))))
 
(defn parent-class-spec [sexprs]
  (let [extends-spec (filter #(= :extends (first %)) sexprs)
        extends (first extends-spec)]
    (if (empty? extends)
      'org.rathore.amit.frumios.core/OBJECT
      (do 
	(if-not (= 1 (count extends-spec))
	  (throw (RuntimeException. "defclass only accepts a single extends clause")))
	(if-not (= 2 (count extends))
	  (throw (RuntimeException. "the extends clause only accepts a single parent class")))
	(last extends)))))
 
(defn method-spec [sexpr]
  (let [name (keyword (second sexpr))
	remaining (next sexpr)]
    {name (conj remaining 'fn)}))
 
(defn method-specs [sexprs]
  (let [method-spec? #(= 'method (first %))
	specs (filter method-spec? sexprs)]
    (apply merge (map method-spec sexprs))))
 
(defmacro defclass [class-name & specs]
  (let [parent-class-symbol (parent-class-spec specs)
        this-class-name (keyword class-name)
	fns (method-specs specs)]
    `(def ~class-name 
        (new-class ~this-class-name (var ~parent-class-symbol) ~(or fns {})))))

But first, examples -

(ns frumios-spec)

(use 'org.rathore.amit.frumios.core)

(defclass animal
  (method sound []
    "grr")

  (method say-something []
    (str (this :sound) ", I say!"))

  (method move []
    "going!"))

(defclass cat
  (:extends animal)

  (method sound []
    "meow"))

There, that defines a simple class hierarchy. Let’s examine these classes -

frumios-spec> (cat :parent)
#'frumios-spec/animal

frumios-spec> (animal :parent)
#'org.rathore.amit.frumios.core/OBJECT

frumios-spec> (animal :method-names)
(:move :say-something :sound)

frumios-spec> (cat :method-names)
(:sound)

Now, let’s define a couple of instances -

(def a (animal :new))
(def c (cat :new))

What can we do with these instances? Let’s explore -

frumios-spec> (c :class)
#'frumios-spec/cat

frumios-spec> (c :set! :name "Mr. Muggles")
nil

frumios-spec> (c :get :name)
"Mr. Muggles"

That’s the basic stuff, how about calling methods?

frumios-spec> (a :move)
"going!"

frumios-spec> (a :sound)
"grr"

frumios-spec> (c :sound)
"meow"

Notice how cat overrides the sound method. OK, how about a method that calls another method? It calls for the this keyword. Here it is in action -

frumios-spec> (a :say-something)
"grr, I say!"

frumios-spec> (c :say-something)
"meow, I say!"

Notice how in the second call, (this :sound) resolved itself to the overridden sound method in the cat class. That’s subtype polymorphism, common to languages such as Java and Ruby. We could use it to implement something like the template pattern. We can do fairly arbitrary things with frumiOS -

(defclass person
  (method greet [visitor]
    (println "Hi" visitor ", I'm here!"))

  (method dob []
    (str "I was born on " (this :get :birth-date)))

  (method age []
    2)

  (method experience [years]
    (str years " years"))

  (method bio []
    (let [msg (str (this :dob) ", and have " (this :experience (this :age)) " of experience.")]
      (println msg))))

Let’s play with it -

frumios-spec> (def kyle (person :new))
#'frumios-spec/kyle

frumios-spec> (kyle :greet "rob")
Hi rob , I'm here!
nil

The bio method makes two calls using the this construct, one nested inside the other. It works as expected -

frumios-spec> (kyle :set! :birth-date "1977-01-01")
nil

frumios-spec> (kyle :bio)
I was born on 1977-01-01, and have 2 years of experience.
nil

So there it is. I’m sure it doesn’t do lots of stuff a real object-system does. But at 70 lines of Clojure code, you can’t expect a whole lot more. Silly as this is, I had fun writing it! Click here to see how the frumiOS is implemented.

About these ads

4 thoughts on “frumiOS – a simple object-system for Clojure

  1. You know about condp?

    (defn new-class
      [class-name parent methods]
      (let [klass ((comp resolve symbol name) class-name)]
        (fn [command & args]
          (condp = command
            :parent       parent
            :name         klass
            :method-names (keys methods)
            :methods      methods
            :new          (new-object klass)
            :method       (let [[method-name] args]
                            (find-method method-name methods parent))
            (throw (RuntimeException. (str "Unknown message: " command)))))))
    

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s