Changes for clojure.contrib.def/name-with-attributes

tsdh on Thu, 10 Nov 2011
;; Here I use name-with-attributes to create a macro writing
;; macro defmacro! that accepts the same args as defmacro itself,
;; i.e., an optional docstring and an optional metadata map.
;; (In contrast to defmacro, overloading is not supported.)

;; Only a helper...
(defn bang-symbol?
  "Returns true, if sym is a symbol with name ending in a exclamation
  mark (bang)."
  [sym]
  (and (symbol? sym)
       (= (last (name sym)) \!)))

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated
  only once in the expansion, even if they are unquoted at several
  places in body.  This is especially important for args whose
  evaluation has side-effecs or who are expensive to evaluate."
  {:arglists '([name doc-string? attr-map? [params*] body])}
  [name & args]
  (let [[name attrs] (tm/name-with-attributes name args)
        meta-map     (meta name)
        args         (first attrs)
        body         (next attrs)
        bang-syms    (filter bang-symbol? (flatten args))
        rep-map      (apply hash-map
                            (mapcat (fn [s] [s `(quote ~(gensym))])
                                    bang-syms))]
    `(defmacro ~name
       ~@(when (seq meta-map) [meta-map])
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/prewalk-replace ~rep-map ~@body)))))
tsdh on Thu, 10 Nov 2011
;; Here I use name-with-attributes to create a macro writing
;; macro defmacro! that accepts the same args as defmacro itself,
;; i.e., an optional docstring and an optional metadata map.
;; (In contrast to defmacro, overloading is not supported.)

;; Only a helper...
(defn bang-symbol?
  "Returns true, if sym is a symbol with name ending in a exclamation
  mark (bang)."
  [sym]
  (and (symbol? sym)
       (= (last (name sym)) \!)))

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated
  only once in the expansion, even if they are unquoted at several
  places in body.  This is especially important for args whose
  evaluation has side-effecs or who are expensive to evaluate."
  {:arglists '([name doc-string? attr-map? [params*] body])}
  [name & args]
  (let [[name attrs] (tm/name-with-attributes name args)
        args         (first attrs)
        body         (next attrs)
        bang-syms    (filter bang-symbol? (flatten args))
        rep-map      (apply hash-map
                            (mapcat (fn [s] [s `(quote ~(gensym))])
                                    bang-syms))]
    `(defmacro ~name
       ~(meta name)
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/prewalk-replace ~rep-map ~@body)))))
tsdh on Thu, 10 Nov 2011
;; Here I use name-with-attributes to create a macro writing
;; macro defmacro! that accepts the same args as defmacro itself,
;; i.e., an optional docstring and an optional metadata map.
;; (In contrast to defmacro, overloading is not supported.)

;; Only a helper...
(defn bang-symbol?
  "Returns true, if sym is a symbol with name ending in a exclamation
  mark (bang)."
  [sym]
  (and (symbol? sym)
       (= (last (name sym)) \!)))

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated
  only once in the expansion, even if they are unquoted at several
  places in body.  This is especially important for args whose
  evaluation has side-effecs or who are expensive to evaluate."
  {:arglists '([name doc-string? attr-map? [params*] body])}
  [name & args]
  (let [[name attrs] (tm/name-with-attributes name args)
        args         (first attrs)
        body         (next attrs)
        bang-syms    (filter bang-symbol? (flatten args))
        rep-map      (apply hash-map
                            (mapcat (fn [s] [s `(quote ~(gensym))])
                                    bang-syms))]
    `(defmacro ~name
       ~(meta name)
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ;; Note: We must use prewalk instead of postwalk so that we replace
          ;; from root to leaves, e.g., we favor replacement of larger s-exps
          ;; over replacements of only parts.
          ~(clojure.walk/prewalk-replace ~rep-map ~@body)))))
tsdh on Thu, 10 Nov 2011
;; Here I use name-with-attributes to create a macro writing
;; macro defmacro! that accepts the same args as defmacro itself,
;; i.e., an optional docstring and an optional metadata map.
;; (In contrast to defmacro, overloading is not supported.)

;; Only a helper...
(defn bang-symbol?
  "Returns true, if sym is a symbol with name ending in a exclamation
  mark (bang)."
  [sym]
  (and (symbol? sym)
       (= (last (name sym)) \!)))

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated
  only once in the expansion, even if they are unquoted at several
  places in body.  This is especially important for args whose
  evaluation has side-effecs or who are expensive to evaluate."
  {:arglists '([name doc-string? attr-map? [params*] body])}
  [name & args]
  (let [[name attrs] (name-with-attributes name args) ;; <== HERE
        args         (first attrs)
        body         (next attrs)
        docstring    (or (:doc (meta name)) "No documentation attached.")
        meta-map     (dissoc (meta name) :doc)
        bang-syms    (filter bang-symbol? (flatten args))
        rep-map      (apply hash-map
                            (mapcat (fn [s] [s `(quote ~(gensym))])
                                    bang-syms))]
    `(defmacro ~name
       ~docstring
       ~@(when (seq meta-map) [meta-map])
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/prewalk-replace ~rep-map ~@body)))))
tsdh on Thu, 10 Nov 2011
;; Here I use name-with-attributes to create a macro writing macro defmacro! that
;; accepts the same args as defmacro itself, i.e., an optional docstring and an
;; optional metadata map.  (In contrast to defmacro, overloading is not supported.)

;; Only a helper...
(defn bang-symbol?
  "Returns true, if sym is a symbol with name ending in a exclamation
  mark (bang)."
  [sym]
  (and (symbol? sym)
       (= (last (name sym)) \!)))

(defmacro defmacro!
  "Defines a macro name with the given docstring, args, and body.
  All args ending in an exclamation mark (!, bang) will be evaluated only once
  in the expansion, even if they are unquoted at several places in body.  This
  is especially important for args whose evaluation has side-effecs or who are
  expensive to evaluate."
  {:arglists '([name doc-string? attr-map? [params*] body])}
  [name & args]
  (let [[name attrs] (name-with-attributes name args) ;; <== HERE
        args         (first attrs)
        body         (next attrs)
        docstring    (or (:doc (meta name)) "No documentation attached.")
        meta-map     (dissoc (meta name) :doc)
        bang-syms    (filter bang-symbol? (flatten args))
        rep-map      (apply hash-map
                            (mapcat (fn [s] [s `(quote ~(gensym))])
                                    bang-syms))]
    `(defmacro ~name
       ~docstring
       ~@(when (seq meta-map) [meta-map])
       ~args
       `(let ~~(vec (mapcat (fn [[s t]] [t s]) rep-map))
          ~(clojure.walk/prewalk-replace ~rep-map ~@body)))))