Mercurial > lasercutter

comparison src/clojure/contrib/def.clj @ 10:ef7dbbd6452c

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