1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/def.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,149 @@
     1.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  File: def.clj
    1.13 +;;
    1.14 +;;  def.clj provides variants of def that make including doc strings and
    1.15 +;;  making private definitions more succinct.
    1.16 +;;
    1.17 +;;  scgilardi (gmail)
    1.18 +;;  17 May 2008
    1.19 +
    1.20 +(ns 
    1.21 +  ^{:author "Stephen C. Gilardi",
    1.22 +    :doc "def.clj provides variants of def that make including doc strings and
    1.23 +making private definitions more succinct."} 
    1.24 +  clojure.contrib.def)
    1.25 +
    1.26 +(defmacro defvar
    1.27 +  "Defines a var with an optional intializer and doc string"
    1.28 +  ([name]
    1.29 +     (list `def name))
    1.30 +  ([name init]
    1.31 +     (list `def name init))
    1.32 +  ([name init doc]
    1.33 +     (list `def (with-meta name (assoc (meta name) :doc doc)) init)))
    1.34 +
    1.35 +(defmacro defunbound
    1.36 +  "Defines an unbound var with optional doc string"
    1.37 +  ([name]
    1.38 +     (list `def name))
    1.39 +  ([name doc]
    1.40 +     (list `def (with-meta name (assoc (meta name) :doc doc)))))
    1.41 +
    1.42 +(defmacro defmacro-
    1.43 +  "Same as defmacro but yields a private definition"
    1.44 +  [name & decls]
    1.45 +  (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls))
    1.46 +
    1.47 +(defmacro defvar-
    1.48 +  "Same as defvar but yields a private definition"
    1.49 +  [name & decls]
    1.50 +  (list* `defvar (with-meta name (assoc (meta name) :private true)) decls))
    1.51 +
    1.52 +(defmacro defunbound-
    1.53 +  "Same as defunbound but yields a private definition"
    1.54 +  [name & decls]
    1.55 +  (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls))
    1.56 +
    1.57 +(defmacro defstruct-
    1.58 +  "Same as defstruct but yields a private definition"
    1.59 +  [name & decls]
    1.60 +  (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls))
    1.61 +
    1.62 +(defmacro defonce-
    1.63 +  "Same as defonce but yields a private definition"
    1.64 +  ([name expr]
    1.65 +     (list `defonce (with-meta name (assoc (meta name) :private true)) expr))
    1.66 +  ([name expr doc]
    1.67 +     (list `defonce (with-meta name (assoc (meta name) :private true :doc doc)) expr)))
    1.68 +
    1.69 +(defmacro defalias
    1.70 +  "Defines an alias for a var: a new var with the same root binding (if
    1.71 +  any) and similar metadata. The metadata of the alias is its initial
    1.72 +  metadata (as provided by def) merged into the metadata of the original."
    1.73 +  ([name orig]
    1.74 +     `(do
    1.75 +        (alter-meta!
    1.76 +         (if (.hasRoot (var ~orig))
    1.77 +           (def ~name (.getRoot (var ~orig)))
    1.78 +           (def ~name))
    1.79 +         ;; When copying metadata, disregard {:macro false}.
    1.80 +         ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
    1.81 +         #(conj (dissoc % :macro)
    1.82 +                (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
    1.83 +        (var ~name)))
    1.84 +  ([name orig doc]
    1.85 +     (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
    1.86 +
    1.87 +; defhinted by Chouser:
    1.88 +(defmacro defhinted
    1.89 +  "Defines a var with a type hint matching the class of the given
    1.90 +  init.  Be careful about using any form of 'def' or 'binding' to a
    1.91 +  value of a different type.  See http://paste.lisp.org/display/73344"
    1.92 +  [sym init]
    1.93 +  `(do
    1.94 +     (def ~sym ~init)
    1.95 +     (alter-meta! (var ~sym) assoc :tag (class ~sym))
    1.96 +     (var ~sym)))
    1.97 +
    1.98 +; name-with-attributes by Konrad Hinsen:
    1.99 +(defn name-with-attributes
   1.100 +  "To be used in macro definitions.
   1.101 +   Handles optional docstrings and attribute maps for a name to be defined
   1.102 +   in a list of macro arguments. If the first macro argument is a string,
   1.103 +   it is added as a docstring to name and removed from the macro argument
   1.104 +   list. If afterwards the first macro argument is a map, its entries are
   1.105 +   added to the name's metadata map and the map is removed from the
   1.106 +   macro argument list. The return value is a vector containing the name
   1.107 +   with its extended metadata map and the list of unprocessed macro
   1.108 +   arguments."
   1.109 +  [name macro-args]
   1.110 +  (let [[docstring macro-args] (if (string? (first macro-args))
   1.111 +                                 [(first macro-args) (next macro-args)]
   1.112 +                                 [nil macro-args])
   1.113 +    [attr macro-args]          (if (map? (first macro-args))
   1.114 +                                 [(first macro-args) (next macro-args)]
   1.115 +                                 [{} macro-args])
   1.116 +    attr                       (if docstring
   1.117 +                                 (assoc attr :doc docstring)
   1.118 +                                 attr)
   1.119 +    attr                       (if (meta name)
   1.120 +                                 (conj (meta name) attr)
   1.121 +                                 attr)]
   1.122 +    [(with-meta name attr) macro-args]))
   1.123 +
   1.124 +; defnk by Meikel Brandmeyer:
   1.125 +(defmacro defnk
   1.126 + "Define a function accepting keyword arguments. Symbols up to the first
   1.127 + keyword in the parameter list are taken as positional arguments.  Then
   1.128 + an alternating sequence of keywords and defaults values is expected. The
   1.129 + values of the keyword arguments are available in the function body by
   1.130 + virtue of the symbol corresponding to the keyword (cf. :keys destructuring).
   1.131 + defnk accepts an optional docstring as well as an optional metadata map."
   1.132 + [fn-name & fn-tail]
   1.133 + (let [[fn-name [args & body]] (name-with-attributes fn-name fn-tail)
   1.134 +       [pos kw-vals]           (split-with symbol? args)
   1.135 +       syms                    (map #(-> % name symbol) (take-nth 2 kw-vals))
   1.136 +       values                  (take-nth 2 (rest kw-vals))
   1.137 +       sym-vals                (apply hash-map (interleave syms values))
   1.138 +       de-map                  {:keys (vec syms)
   1.139 +                                :or   sym-vals}]
   1.140 +   `(defn ~fn-name
   1.141 +      [~@pos & options#]
   1.142 +      (let [~de-map (apply hash-map options#)]
   1.143 +        ~@body))))
   1.144 +
   1.145 +; defn-memo by Chouser:
   1.146 +(defmacro defn-memo
   1.147 +  "Just like defn, but memoizes the function using clojure.core/memoize"
   1.148 +  [fn-name & defn-stuff]
   1.149 +  `(do
   1.150 +     (defn ~fn-name ~@defn-stuff)
   1.151 +     (alter-var-root (var ~fn-name) memoize)
   1.152 +     (var ~fn-name)))