Skip to content

Instantly share code, notes, and snippets.

@jackrusher
Last active August 17, 2024 12:28
Show Gist options
  • Save jackrusher/5653669 to your computer and use it in GitHub Desktop.
Save jackrusher/5653669 to your computer and use it in GitHub Desktop.
An old programming koan.

The venerable master Qc Na was walking with his student, Anton. Hoping to prompt the master into a discussion, Anton said "Master, I have heard that objects are a very good thing - is this true?" Qc Na looked pityingly at his student and replied, "Foolish pupil - objects are merely a poor man's closures."

Chastised, Anton took his leave from his master and returned to his cell, intent on studying closures. He carefully read the entire "Lambda: The Ultimate..." series of papers and its cousins, and implemented a small Scheme interpreter with a closure-based object system. He learned much, and looked forward to informing his master of his progress.

On his next walk with Qc Na, Anton attempted to impress his master by saying "Master, I have diligently studied the matter, and now understand that objects are truly a poor man's closures." Qc Na responded by hitting Anton with his stick, saying "When will you learn? Closures are a poor man's object." At that moment, Anton became enlightened.

From: http://people.csail.mit.edu/gregs/ll1-discuss-archive-html/msg03277.html

(defmacro defclass [class-name & slots]
(let [ctor-name (symbol (str "new-" class-name))
slot-map (apply hash-map slots)]
`(defn ~ctor-name [& init-values#]
(let [this-ptr# (ref (merge ~slot-map (apply hash-map init-values#)))
meths# (apply hash-map
(mapcat (fn [slot#] (list
(.replace (str slot#) ":" ":get-")
#((deref this-ptr#) slot#)
(.replace (str slot#) ":" ":set-")
#(dosync (alter this-ptr# assoc slot# %))))
(keys ~slot-map)))]
(fn [& args#] (apply (get meths# (str (first args#))) (rest args#)))))))
;; new fighter class with defaults for slots
(defclass fighter :height 1.78 :weight 80 :reach 1.83)
;; a new fighter instance with default values
(def wallace (new-fighter))
(wallace :get-weight)
;; => 80
;; a new fighter instance with a default overridden
(def butch (new-fighter :weight 78))
(butch :get-weight)
;; => 78
(butch :get-reach)
;; => 1.83
;; call the setter on this object's reach
(butch :set-reach 1.78)
;; => {:weight 78, :height 1.78, :reach 1.78}
(butch :get-reach)
;; => 1.78
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment