|
rlm@10
|
1 ;; Various useful macros
|
|
rlm@10
|
2 ;;
|
|
rlm@10
|
3 ;; Everybody is invited to add their own little macros here!
|
|
rlm@10
|
4 ;;
|
|
rlm@10
|
5 ;; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
6 ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
7 ;; which can be found in the file epl-v10.html at the root of this
|
|
rlm@10
|
8 ;; distribution. By using this software in any fashion, you are
|
|
rlm@10
|
9 ;; agreeing to be bound by the terms of this license. You must not
|
|
rlm@10
|
10 ;; remove this notice, or any other, from this software.
|
|
rlm@10
|
11
|
|
rlm@10
|
12 (ns
|
|
rlm@10
|
13 ^{:author "Konrad Hinsen"
|
|
rlm@10
|
14 :doc "Various small macros"}
|
|
rlm@10
|
15 clojure.contrib.macros)
|
|
rlm@10
|
16
|
|
rlm@10
|
17 ;; By Konrad Hinsen
|
|
rlm@10
|
18 (defmacro const
|
|
rlm@10
|
19 "Evaluate the constant expression expr at compile time."
|
|
rlm@10
|
20 [expr]
|
|
rlm@10
|
21 (eval expr))
|
|
rlm@10
|
22
|
|
rlm@10
|
23 ;; By Konrad Hinsen
|
|
rlm@10
|
24 ; This macro is made obsolete by Clojure's built-in letfn. I renamed it to
|
|
rlm@10
|
25 ; letfn- (to avoid a name clash) but leave it in for a while, since its
|
|
rlm@10
|
26 ; syntax is not quite the same as Clojure's. Expect this to disappear
|
|
rlm@10
|
27 ; in the long run!
|
|
rlm@10
|
28 (defmacro letfn-
|
|
rlm@10
|
29 "OBSOLETE: use clojure.core/letfn
|
|
rlm@10
|
30 A variant of let for local function definitions. fn-bindings consists
|
|
rlm@10
|
31 of name/args/body triples, with (letfn [name args body] ...)
|
|
rlm@10
|
32 being equivalent to (let [name (fn name args body)] ...)."
|
|
rlm@10
|
33 [fn-bindings & exprs]
|
|
rlm@10
|
34 (let [makefn (fn [[name args body]] (list name (list 'fn name args body)))
|
|
rlm@10
|
35 fns (vec (apply concat (map makefn (partition 3 fn-bindings))))]
|
|
rlm@10
|
36 `(let ~fns ~@exprs)))
|
|
rlm@10
|
37
|
|
rlm@10
|
38 ;; By Konrad Hinsen
|
|
rlm@10
|
39
|
|
rlm@10
|
40 (defn- unqualified-symbol
|
|
rlm@10
|
41 [s]
|
|
rlm@10
|
42 (let [s-str (str s)]
|
|
rlm@10
|
43 (symbol (subs s-str (inc (.indexOf s-str (int \/)))))))
|
|
rlm@10
|
44
|
|
rlm@10
|
45 (defn- bound-var?
|
|
rlm@10
|
46 [var]
|
|
rlm@10
|
47 (try
|
|
rlm@10
|
48 (do (deref var) true)
|
|
rlm@10
|
49 (catch java.lang.IllegalStateException e false)))
|
|
rlm@10
|
50
|
|
rlm@10
|
51 (defn- fns-from-ns
|
|
rlm@10
|
52 [ns ns-symbol]
|
|
rlm@10
|
53 (apply concat
|
|
rlm@10
|
54 (for [[k v] (ns-publics ns)
|
|
rlm@10
|
55 :when (and (bound-var? v)
|
|
rlm@10
|
56 (fn? @v)
|
|
rlm@10
|
57 (not (:macro (meta v))))]
|
|
rlm@10
|
58 [k (symbol (str ns-symbol) (str k))])))
|
|
rlm@10
|
59
|
|
rlm@10
|
60 (defn- expand-symbol
|
|
rlm@10
|
61 [ns-or-var-sym]
|
|
rlm@10
|
62 (if (= ns-or-var-sym '*ns*)
|
|
rlm@10
|
63 (fns-from-ns *ns* (ns-name *ns*))
|
|
rlm@10
|
64 (if-let [ns (find-ns ns-or-var-sym)]
|
|
rlm@10
|
65 (fns-from-ns ns ns-or-var-sym)
|
|
rlm@10
|
66 (list (unqualified-symbol ns-or-var-sym) ns-or-var-sym))))
|
|
rlm@10
|
67
|
|
rlm@10
|
68 (defmacro with-direct-linking
|
|
rlm@10
|
69 "EXPERIMENTAL!
|
|
rlm@10
|
70 Compiles the functions in body with direct links to the functions
|
|
rlm@10
|
71 named in symbols, i.e. without a var lookup for each invocation.
|
|
rlm@10
|
72 Symbols is a vector of symbols that name either vars or namespaces.
|
|
rlm@10
|
73 A namespace reference is replaced by the list of all symbols in the
|
|
rlm@10
|
74 namespace that are bound to functions. If symbols is not provided,
|
|
rlm@10
|
75 the default value ['clojure.core] is used. The symbol *ns* can be
|
|
rlm@10
|
76 used to refer to the current namespace."
|
|
rlm@10
|
77 {:arglists '([symbols? & body])}
|
|
rlm@10
|
78 [& body]
|
|
rlm@10
|
79 (let [[symbols body] (if (vector? (first body))
|
|
rlm@10
|
80 [(first body) (rest body)]
|
|
rlm@10
|
81 [['clojure.core] body])
|
|
rlm@10
|
82 bindings (vec (mapcat expand-symbol symbols))]
|
|
rlm@10
|
83 `(let ~bindings ~@body)))
|
|
rlm@10
|
84 |
