Skip to content

Instantly share code, notes, and snippets.

@chrisdew
Created October 18, 2012 12:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save chrisdew/3911372 to your computer and use it in GitHub Desktop.
Save chrisdew/3911372 to your computer and use it in GitHub Desktop.
Adventures with multimethods.
(def class-keyword-map (atom {}))
(defn class-keyword
[instance]
(@class-keyword-map (class instance)))
(defmacro defadrec
[klass & body]
`(do
; create the record as normal
(defrecord ~klass ~@body)
; and add the type to the keyword lookup
(swap!
class-keyword-map
assoc ~klass (keyword (str *ns*) (str '~klass)))))
(defadrec Item [name])
(defadrec Sword [name, damage])
(defadrec Furniture [name])
(defadrec Cupboard [name])
(defadrec Stairs [name])
(defadrec Container [name])
(defadrec Bag [name])
(defadrec Exit [name])
; things
(derive ::Sword ::Item)
(derive ::Container ::Item)
(derive ::Bag ::Container)
(derive ::Cupboard ::Container)
(derive ::Cupboard ::Furniture)
(derive ::Stairs ::Furniture)
(derive ::Stairs ::Exit)
; nouns
(derive ::get ::get-take)
(derive ::take ::get-take)
(derive ::take ::follow)
(def sword (Sword. "sword" 10))
(def apple (Item. "apple"))
(def cupboard (Furniture. "cupboard"))
(def stairs (Stairs. "stairs"))
(def bag (Bag. "bag"))
(def highroad (Exit. "highroad"))
(defmulti exec3 (fn [verb src dst] [verb (class-keyword src) (class-keyword dst)]))
(defmethod exec3 [::put ::Item ::Container] [verb src dst] "success")
(defmethod exec3 [::put ::Sword ::Bag] [verb src dst] "the sword cuts the bag")
(defmethod exec3 [::put ::Item ::Container] [verb src dst] "success")
(defmulti exec2 (fn [verb noun] [verb (class-keyword noun)]))
(defmethod exec2 [::get-take ::Item] [verb noun] "you get it")
(defmethod exec2 [::get-take ::Furniture] [verb noun] "it's too heavy")
(defmethod exec2 [::take ::Stairs] [verb noun] "you climb the stairs")
(defmethod exec2 [::follow ::Exit] [verb noun] "you leave")
(prefer-method exec2 [:user/climb :user/Stairs] [:user/get-take :user/Item])
(println (exec3 ::put apple bag))
; success
(println (exec3 ::put sword bag))
; the sword cuts the bag
(println (exec2 ::get bag))
; you get it
(println (exec2 ::take bag))
; you get it
(println (exec2 ::get stairs))
; it's too heavy
(println (exec2 ::take stairs))
; you climb the stairs
(println (exec2 ::take highroad))
; you leave
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment