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