Mercurial > lasercutter

     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
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children