Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Fetching contributors…
Cannot retrieve contributors at this time
103 lines (82 sloc) 2.92 KB
(ns joy.macros
"Examples of macros from chapter 8")
(defn contextual-eval [ctx expr]
`(let [~@(mapcat (fn [[k v]] [k `'~v]) ctx)]
(defmacro do-until [& clauses]
(when clauses
(list `when (first clauses)
(if (next clauses)
(second clauses)
(throw (IllegalArgumentException.
"do-until requires an even number of forms")))
(cons 'do-until (next (next clauses))))))
(defmacro unless [condition & body]
`(if (not ~condition) ;; #1_unless: Unquote condition
(do ~@body))) ;; #2_unless: Splice body
(defn from-end [s n] ;; #3_unless: Use our unless
(let [delta (dec (- (count s) n))]
(unless (neg? delta) ;; #4_unless: Return nil if negative
(nth s delta))))
(defmacro def-watched [name & value]
(def ~name ~@value)
(add-watch (var ~name)
(fn [~'key ~'r old# new#]
(println old# " -> " new#)))))
;; Domain DSL
(defmacro domain [name & body]
`{:tag :domain,
:attrs {:name (str '~name)},
:content [~@body]})
(declare handle-things)
(defmacro grouping [name & body]
`{:tag :grouping,
:attrs {:name (str '~name)},
:content [~@(handle-things body)]})
(declare grok-attrs grok-props)
(defn handle-things [things]
(for [t things]
{:tag :thing,
:attrs (grok-attrs (take-while (comp not vector?) t))
:content (if-let [c (grok-props (drop-while (comp not vector?) t))
(defn grok-attrs [attrs]
(into {:name (str (first attrs))}
(for [a (rest attrs)]
(list? a) [:isa (str (second a))]
(string? a) [:comment a]))))
(defn grok-props [props]
(when props
{:tag :properties, :attrs nil,
:content (apply vector (for [p props]
{:tag :property,
:attrs {:name (str (first p))},
:content nil}))}))
(def d
(domain man-vs-monster
(grouping people ;; #: Group of people
(Human "A stock human") ;; #: One kind of person
(Man (isa Human) ;; #: Another kind of person
"A man, baby"
(grouping monsters ;; #: Group of monsters
(Chupacabra ;; #: One kind of monster
"A fierce, yet elusive creature"
;; anaphora
(defmacro awhen [expr & body]
`(let [~'it ~expr] ;; #1_awhen: Define anaphora
(if ~'it ;; #2_awhen: Check its truth
(do ~@body)))) ;; #3_awhen: Inline the body
;; a Lispy design pattern!
(defmacro with-resource [binding close-fn & body]
`(let ~binding
(try (do ~@body)
(~close-fn ~(binding 0))))))
Jump to Line
Something went wrong with that request. Please try again.