|
rlm@10
|
1 ;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
|
|
rlm@10
|
2 ;; distribution terms for this software are covered by the Eclipse Public
|
|
rlm@10
|
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
|
|
rlm@10
|
4 ;; be found in the file epl-v10.html at the root of this distribution. By
|
|
rlm@10
|
5 ;; using this software in any fashion, you are agreeing to be bound by the
|
|
rlm@10
|
6 ;; terms of this license. You must not remove this notice, or any other,
|
|
rlm@10
|
7 ;; from this software.
|
|
rlm@10
|
8 ;;
|
|
rlm@10
|
9 ;; File: def.clj
|
|
rlm@10
|
10 ;;
|
|
rlm@10
|
11 ;; def.clj provides variants of def that make including doc strings and
|
|
rlm@10
|
12 ;; making private definitions more succinct.
|
|
rlm@10
|
13 ;;
|
|
rlm@10
|
14 ;; scgilardi (gmail)
|
|
rlm@10
|
15 ;; 17 May 2008
|
|
rlm@10
|
16
|
|
rlm@10
|
17 (ns
|
|
rlm@10
|
18 ^{:author "Stephen C. Gilardi",
|
|
rlm@10
|
19 :doc "def.clj provides variants of def that make including doc strings and
|
|
rlm@10
|
20 making private definitions more succinct."}
|
|
rlm@10
|
21 clojure.contrib.def)
|
|
rlm@10
|
22
|
|
rlm@10
|
23 (defmacro defvar
|
|
rlm@10
|
24 "Defines a var with an optional intializer and doc string"
|
|
rlm@10
|
25 ([name]
|
|
rlm@10
|
26 (list `def name))
|
|
rlm@10
|
27 ([name init]
|
|
rlm@10
|
28 (list `def name init))
|
|
rlm@10
|
29 ([name init doc]
|
|
rlm@10
|
30 (list `def (with-meta name (assoc (meta name) :doc doc)) init)))
|
|
rlm@10
|
31
|
|
rlm@10
|
32 (defmacro defunbound
|
|
rlm@10
|
33 "Defines an unbound var with optional doc string"
|
|
rlm@10
|
34 ([name]
|
|
rlm@10
|
35 (list `def name))
|
|
rlm@10
|
36 ([name doc]
|
|
rlm@10
|
37 (list `def (with-meta name (assoc (meta name) :doc doc)))))
|
|
rlm@10
|
38
|
|
rlm@10
|
39 (defmacro defmacro-
|
|
rlm@10
|
40 "Same as defmacro but yields a private definition"
|
|
rlm@10
|
41 [name & decls]
|
|
rlm@10
|
42 (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls))
|
|
rlm@10
|
43
|
|
rlm@10
|
44 (defmacro defvar-
|
|
rlm@10
|
45 "Same as defvar but yields a private definition"
|
|
rlm@10
|
46 [name & decls]
|
|
rlm@10
|
47 (list* `defvar (with-meta name (assoc (meta name) :private true)) decls))
|
|
rlm@10
|
48
|
|
rlm@10
|
49 (defmacro defunbound-
|
|
rlm@10
|
50 "Same as defunbound but yields a private definition"
|
|
rlm@10
|
51 [name & decls]
|
|
rlm@10
|
52 (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls))
|
|
rlm@10
|
53
|
|
rlm@10
|
54 (defmacro defstruct-
|
|
rlm@10
|
55 "Same as defstruct but yields a private definition"
|
|
rlm@10
|
56 [name & decls]
|
|
rlm@10
|
57 (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls))
|
|
rlm@10
|
58
|
|
rlm@10
|
59 (defmacro defonce-
|
|
rlm@10
|
60 "Same as defonce but yields a private definition"
|
|
rlm@10
|
61 ([name expr]
|
|
rlm@10
|
62 (list `defonce (with-meta name (assoc (meta name) :private true)) expr))
|
|
rlm@10
|
63 ([name expr doc]
|
|
rlm@10
|
64 (list `defonce (with-meta name (assoc (meta name) :private true :doc doc)) expr)))
|
|
rlm@10
|
65
|
|
rlm@10
|
66 (defmacro defalias
|
|
rlm@10
|
67 "Defines an alias for a var: a new var with the same root binding (if
|
|
rlm@10
|
68 any) and similar metadata. The metadata of the alias is its initial
|
|
rlm@10
|
69 metadata (as provided by def) merged into the metadata of the original."
|
|
rlm@10
|
70 ([name orig]
|
|
rlm@10
|
71 `(do
|
|
rlm@10
|
72 (alter-meta!
|
|
rlm@10
|
73 (if (.hasRoot (var ~orig))
|
|
rlm@10
|
74 (def ~name (.getRoot (var ~orig)))
|
|
rlm@10
|
75 (def ~name))
|
|
rlm@10
|
76 ;; When copying metadata, disregard {:macro false}.
|
|
rlm@10
|
77 ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
|
|
rlm@10
|
78 #(conj (dissoc % :macro)
|
|
rlm@10
|
79 (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
|
|
rlm@10
|
80 (var ~name)))
|
|
rlm@10
|
81 ([name orig doc]
|
|
rlm@10
|
82 (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
|
|
rlm@10
|
83
|
|
rlm@10
|
84 ; defhinted by Chouser:
|
|
rlm@10
|
85 (defmacro defhinted
|
|
rlm@10
|
86 "Defines a var with a type hint matching the class of the given
|
|
rlm@10
|
87 init. Be careful about using any form of 'def' or 'binding' to a
|
|
rlm@10
|
88 value of a different type. See http://paste.lisp.org/display/73344"
|
|
rlm@10
|
89 [sym init]
|
|
rlm@10
|
90 `(do
|
|
rlm@10
|
91 (def ~sym ~init)
|
|
rlm@10
|
92 (alter-meta! (var ~sym) assoc :tag (class ~sym))
|
|
rlm@10
|
93 (var ~sym)))
|
|
rlm@10
|
94
|
|
rlm@10
|
95 ; name-with-attributes by Konrad Hinsen:
|
|
rlm@10
|
96 (defn name-with-attributes
|
|
rlm@10
|
97 "To be used in macro definitions.
|
|
rlm@10
|
98 Handles optional docstrings and attribute maps for a name to be defined
|
|
rlm@10
|
99 in a list of macro arguments. If the first macro argument is a string,
|
|
rlm@10
|
100 it is added as a docstring to name and removed from the macro argument
|
|
rlm@10
|
101 list. If afterwards the first macro argument is a map, its entries are
|
|
rlm@10
|
102 added to the name's metadata map and the map is removed from the
|
|
rlm@10
|
103 macro argument list. The return value is a vector containing the name
|
|
rlm@10
|
104 with its extended metadata map and the list of unprocessed macro
|
|
rlm@10
|
105 arguments."
|
|
rlm@10
|
106 [name macro-args]
|
|
rlm@10
|
107 (let [[docstring macro-args] (if (string? (first macro-args))
|
|
rlm@10
|
108 [(first macro-args) (next macro-args)]
|
|
rlm@10
|
109 [nil macro-args])
|
|
rlm@10
|
110 [attr macro-args] (if (map? (first macro-args))
|
|
rlm@10
|
111 [(first macro-args) (next macro-args)]
|
|
rlm@10
|
112 [{} macro-args])
|
|
rlm@10
|
113 attr (if docstring
|
|
rlm@10
|
114 (assoc attr :doc docstring)
|
|
rlm@10
|
115 attr)
|
|
rlm@10
|
116 attr (if (meta name)
|
|
rlm@10
|
117 (conj (meta name) attr)
|
|
rlm@10
|
118 attr)]
|
|
rlm@10
|
119 [(with-meta name attr) macro-args]))
|
|
rlm@10
|
120
|
|
rlm@10
|
121 ; defnk by Meikel Brandmeyer:
|
|
rlm@10
|
122 (defmacro defnk
|
|
rlm@10
|
123 "Define a function accepting keyword arguments. Symbols up to the first
|
|
rlm@10
|
124 keyword in the parameter list are taken as positional arguments. Then
|
|
rlm@10
|
125 an alternating sequence of keywords and defaults values is expected. The
|
|
rlm@10
|
126 values of the keyword arguments are available in the function body by
|
|
rlm@10
|
127 virtue of the symbol corresponding to the keyword (cf. :keys destructuring).
|
|
rlm@10
|
128 defnk accepts an optional docstring as well as an optional metadata map."
|
|
rlm@10
|
129 [fn-name & fn-tail]
|
|
rlm@10
|
130 (let [[fn-name [args & body]] (name-with-attributes fn-name fn-tail)
|
|
rlm@10
|
131 [pos kw-vals] (split-with symbol? args)
|
|
rlm@10
|
132 syms (map #(-> % name symbol) (take-nth 2 kw-vals))
|
|
rlm@10
|
133 values (take-nth 2 (rest kw-vals))
|
|
rlm@10
|
134 sym-vals (apply hash-map (interleave syms values))
|
|
rlm@10
|
135 de-map {:keys (vec syms)
|
|
rlm@10
|
136 :or sym-vals}]
|
|
rlm@10
|
137 `(defn ~fn-name
|
|
rlm@10
|
138 [~@pos & options#]
|
|
rlm@10
|
139 (let [~de-map (apply hash-map options#)]
|
|
rlm@10
|
140 ~@body))))
|
|
rlm@10
|
141
|
|
rlm@10
|
142 ; defn-memo by Chouser:
|
|
rlm@10
|
143 (defmacro defn-memo
|
|
rlm@10
|
144 "Just like defn, but memoizes the function using clojure.core/memoize"
|
|
rlm@10
|
145 [fn-name & defn-stuff]
|
|
rlm@10
|
146 `(do
|
|
rlm@10
|
147 (defn ~fn-name ~@defn-stuff)
|
|
rlm@10
|
148 (alter-var-root (var ~fn-name) memoize)
|
|
rlm@10
|
149 (var ~fn-name)))
|
