1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/macro_utils.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,270 @@
     1.4 +;; Macrolet and symbol-macrolet
     1.5 +
     1.6 +;; by Konrad Hinsen
     1.7 +;; last updated January 14, 2010
     1.8 +
     1.9 +;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved.  The use
    1.10 +;; and distribution terms for this software are covered by the Eclipse
    1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;; which can be found in the file epl-v10.html at the root of this
    1.13 +;; distribution.  By using this software in any fashion, you are
    1.14 +;; agreeing to be bound by the terms of this license.  You must not
    1.15 +;; remove this notice, or any other, from this software.
    1.16 +
    1.17 +(ns
    1.18 +  ^{:author "Konrad Hinsen"
    1.19 +     :doc "Local macros and symbol macros
    1.20 +
    1.21 +           Local macros are defined by a macrolet form. They are usable only
    1.22 +           inside its body. Symbol macros can be defined globally
    1.23 +           (defsymbolmacro) or locally (symbol-macrolet). A symbol
    1.24 +           macro defines a form that replaces a symbol during macro
    1.25 +           expansion. Function arguments and symbols bound in let
    1.26 +           forms are not subject to symbol macro expansion.
    1.27 +
    1.28 +           Local macros are most useful in the definition of the expansion
    1.29 +           of another macro, they may be used anywhere. Global symbol
    1.30 +           macros can be used only inside a with-symbol-macros form."}
    1.31 +  clojure.contrib.macro-utils
    1.32 +  (:use [clojure.contrib.def :only (defvar-)]))
    1.33 +
    1.34 +; A set of all special forms. Special forms are not macro-expanded, making
    1.35 +; it impossible to shadow them by macro definitions. For most special
    1.36 +; forms, all the arguments are simply macro-expanded, but some forms
    1.37 +; get special treatment.
    1.38 +(defvar- special-forms
    1.39 +  (into #{} (keys clojure.lang.Compiler/specials)))
    1.40 +; Value in the Clojure 1.2 branch:
    1.41 +; #{deftype* new quote & var set! monitor-enter recur . case* clojure.core/import* reify* do fn* throw monitor-exit letfn* finally let* loop* try catch if def}
    1.42 +
    1.43 +; The following three vars are constantly redefined using the binding
    1.44 +; form, imitating dynamic scoping.
    1.45 +;
    1.46 +; Local macros.
    1.47 +(defvar- macro-fns {})
    1.48 +; Local symbol macros.
    1.49 +(defvar- macro-symbols {})
    1.50 +; Symbols defined inside let forms or function arguments.
    1.51 +(defvar- protected-symbols #{})
    1.52 +
    1.53 +(defn- reserved?
    1.54 +  [symbol]
    1.55 +  "Return true if symbol is a reserved symbol (starting or ending with a dot)."
    1.56 +  (let [s (str symbol)]
    1.57 +    (or (= "." (subs s 0 1))
    1.58 +	(= "." (subs s (dec (count s)))))))
    1.59 +
    1.60 +(defn- expand-symbol
    1.61 +  "Expand symbol macros"
    1.62 +  [symbol]
    1.63 +  (cond (contains? protected-symbols symbol) symbol
    1.64 +	(reserved? symbol)                   symbol
    1.65 +	(contains? macro-symbols symbol)     (get macro-symbols symbol)
    1.66 +	:else (let [v (resolve symbol)
    1.67 +		    m (meta v)]
    1.68 +		(if (:symbol-macro m)
    1.69 +		  (var-get v)
    1.70 +		  symbol))))
    1.71 +
    1.72 +(defn- expand-1
    1.73 +  "Perform a single non-recursive macro expansion of form."
    1.74 +  [form]
    1.75 +  (cond
    1.76 +    (seq? form)
    1.77 +      (let [f (first form)]
    1.78 +        (cond (contains? special-forms f) form
    1.79 +	      (contains? macro-fns f)     (apply (get macro-fns f) (rest form))
    1.80 +	      (symbol? f)                 (let [exp (expand-symbol f)]
    1.81 +					    (if (= exp f)
    1.82 +					      (clojure.core/macroexpand-1 form)
    1.83 +					      (cons exp (rest form))))
    1.84 +	      ; handle defmacro macros and Java method special forms
    1.85 +	      :else (clojure.core/macroexpand-1 form)))
    1.86 +    (symbol? form)
    1.87 +      (expand-symbol form)
    1.88 +     :else
    1.89 +       form))
    1.90 +
    1.91 +(defn- expand
    1.92 +  "Perform repeated non-recursive macro expansion of form, until it no
    1.93 +   longer changes."
    1.94 +  [form]
    1.95 +  (let [ex (expand-1 form)]
    1.96 +    (if (identical? ex form)
    1.97 +      form
    1.98 +      (recur ex))))
    1.99 +
   1.100 +(declare expand-all)
   1.101 +
   1.102 +(defn- expand-args
   1.103 +  "Recursively expand the arguments of form, leaving its first
   1.104 +   n elements unchanged."
   1.105 +  ([form]
   1.106 +   (expand-args form 1))
   1.107 +  ([form n]
   1.108 +   (doall (concat (take n form) (map expand-all (drop n form))))))
   1.109 +
   1.110 +(defn- expand-bindings
   1.111 +  [bindings exprs]
   1.112 +  (if (empty? bindings)
   1.113 +    (list (doall (map expand-all exprs)))
   1.114 +    (let [[[s b] & bindings] bindings]
   1.115 +      (let [b (expand-all b)]
   1.116 +	(binding [protected-symbols (conj protected-symbols s)]
   1.117 +	  (doall (cons [s b] (expand-bindings bindings exprs))))))))
   1.118 +
   1.119 +(defn- expand-with-bindings
   1.120 +  "Handle let* and loop* forms. The symbols defined in them are protected
   1.121 +   from symbol macro expansion, the definitions and the body expressions
   1.122 +   are expanded recursively."
   1.123 +  [form]
   1.124 +  (let [f        (first form)
   1.125 +	bindings (partition 2 (second form))
   1.126 +	exprs    (rest (rest form))
   1.127 +	expanded (expand-bindings bindings exprs)
   1.128 +	bindings (vec (apply concat (butlast expanded)))
   1.129 +	exprs    (last expanded)]
   1.130 +    (cons f (cons bindings exprs))))
   1.131 +
   1.132 +(defn- expand-fn-body
   1.133 +  [[args & exprs]]
   1.134 +  (binding [protected-symbols (reduce conj protected-symbols
   1.135 +				     (filter #(not (= % '&)) args))]
   1.136 +    (cons args (doall (map expand-all exprs)))))
   1.137 +
   1.138 +(defn- expand-fn
   1.139 +  "Handle fn* forms. The arguments are protected from symbol macro
   1.140 +   expansion, the bodies are expanded recursively."
   1.141 +  [form]
   1.142 +  (let [[f & bodies] form
   1.143 +	name         (when (symbol? (first bodies)) (first bodies))
   1.144 +	bodies       (if (symbol? (first bodies)) (rest bodies) bodies)
   1.145 +	bodies       (if (vector? (first bodies)) (list bodies) bodies)
   1.146 +	bodies       (doall (map expand-fn-body bodies))]
   1.147 +    (if (nil? name)
   1.148 +      (cons f bodies)
   1.149 +      (cons f (cons name bodies)))))
   1.150 +
   1.151 +(defn- expand-method
   1.152 +  "Handle a method in a deftype* or reify* form."
   1.153 +  [m]
   1.154 +  (rest (expand-fn (cons 'fn* m))))
   1.155 +
   1.156 +(defn- expand-deftype
   1.157 +  "Handle deftype* forms."
   1.158 +  [[symbol typename classname fields implements interfaces & methods]]
   1.159 +  (assert (= implements :implements))
   1.160 +  (let [expanded-methods (map expand-method methods)]
   1.161 +    (concat
   1.162 +     (list symbol typename classname fields implements interfaces)
   1.163 +     expanded-methods)))
   1.164 +
   1.165 +(defn- expand-reify
   1.166 +  "Handle reify* forms."
   1.167 +  [[symbol interfaces & methods]]
   1.168 +  (let [expanded-methods (map expand-method methods)]
   1.169 +    (cons symbol (cons interfaces expanded-methods))))
   1.170 +
   1.171 +; Handlers for special forms that require special treatment. The default
   1.172 +; is expand-args.
   1.173 +(defvar- special-form-handlers
   1.174 +  {'quote 	  identity
   1.175 +   'var   	  identity
   1.176 +   'def   	  #(expand-args % 2)
   1.177 +   'new           #(expand-args % 2)
   1.178 +   'let*          expand-with-bindings
   1.179 +   'loop*         expand-with-bindings
   1.180 +   'fn*           expand-fn
   1.181 +   'deftype*      expand-deftype
   1.182 +   'reify*        expand-reify})
   1.183 +
   1.184 +(defn- expand-list
   1.185 +  "Recursively expand a form that is a list or a cons."
   1.186 +  [form]
   1.187 +  (let [f (first form)]
   1.188 +    (if (symbol? f)
   1.189 +      (if (contains? special-forms f)
   1.190 +	((get special-form-handlers f expand-args) form)
   1.191 +	(expand-args form))
   1.192 +      (doall (map expand-all form)))))
   1.193 +
   1.194 +(defn- expand-all
   1.195 +  "Expand a form recursively."
   1.196 +  [form]
   1.197 +  (let [exp (expand form)]
   1.198 +    (cond (symbol? exp) exp
   1.199 +	  (seq? exp) (expand-list exp)
   1.200 +	  (vector? exp) (into [] (map expand-all exp))
   1.201 +	  (map? exp) (into {} (map expand-all (seq exp)))
   1.202 +	  :else exp)))
   1.203 +
   1.204 +(defmacro macrolet
   1.205 +  "Define local macros that are used in the expansion of exprs. The
   1.206 +   syntax is the same as for letfn forms."
   1.207 +  [fn-bindings & exprs]
   1.208 +  (let [names      (map first fn-bindings)
   1.209 +	name-map   (into {} (map (fn [n] [(list 'quote n) n]) names))
   1.210 +	macro-map  (eval `(letfn ~fn-bindings ~name-map))]
   1.211 +    (binding [macro-fns     (merge macro-fns macro-map)
   1.212 +	      macro-symbols (apply dissoc macro-symbols names)]
   1.213 +      `(do ~@(doall (map expand-all exprs))))))
   1.214 +
   1.215 +(defmacro symbol-macrolet
   1.216 +  "Define local symbol macros that are used in the expansion of exprs.
   1.217 +   The syntax is the same as for let forms."
   1.218 +  [symbol-bindings & exprs]
   1.219 +  (let [symbol-map (into {} (map vec (partition 2 symbol-bindings)))
   1.220 +	names      (keys symbol-map)]
   1.221 +    (binding [macro-fns     (apply dissoc macro-fns names)
   1.222 +	      macro-symbols (merge macro-symbols symbol-map)]
   1.223 +      `(do ~@(doall (map expand-all exprs))))))
   1.224 +
   1.225 +(defmacro defsymbolmacro
   1.226 +  "Define a symbol macro. Because symbol macros are not part of
   1.227 +   Clojure's built-in macro expansion system, they can be used only
   1.228 +   inside a with-symbol-macros form."
   1.229 +  [symbol expansion]
   1.230 +  (let [meta-map (if (meta symbol) (meta symbol) {})
   1.231 +	meta-map (assoc meta-map :symbol-macro true)]
   1.232 +  `(def ~(with-meta symbol meta-map) (quote ~expansion))))
   1.233 +
   1.234 +(defmacro with-symbol-macros
   1.235 +  "Fully expand exprs, including symbol macros."
   1.236 +  [& exprs]
   1.237 +  `(do ~@(doall (map expand-all exprs))))
   1.238 +
   1.239 +(defmacro deftemplate
   1.240 +  "Define a macro that expands into forms after replacing the
   1.241 +   symbols in params (a vector) by the corresponding parameters
   1.242 +   given in the macro call."
   1.243 +  [name params & forms]
   1.244 +  (let [param-map (for [p params] (list (list 'quote p) (gensym)))
   1.245 +	template-params (vec (map second param-map))
   1.246 +	param-map (vec (apply concat param-map))
   1.247 +	expansion (list 'list (list 'quote `symbol-macrolet) param-map
   1.248 +			(list 'quote (cons 'do forms)))]
   1.249 +    `(defmacro ~name ~template-params ~expansion)))
   1.250 +
   1.251 +(defn mexpand-1
   1.252 +  "Like clojure.core/macroexpand-1, but takes into account symbol macros."
   1.253 +  [form]
   1.254 +  (binding [macro-fns {}
   1.255 +	    macro-symbols {}
   1.256 +	    protected-symbols #{}]
   1.257 +    (expand-1 form)))
   1.258 +
   1.259 +(defn mexpand
   1.260 +  "Like clojure.core/macroexpand, but takes into account symbol macros."
   1.261 +  [form]
   1.262 +  (binding [macro-fns {}
   1.263 +	    macro-symbols {}
   1.264 +	    protected-symbols #{}]
   1.265 +    (expand form)))
   1.266 +
   1.267 +(defn mexpand-all
   1.268 +  "Perform a full recursive macro expansion of a form."
   1.269 +  [form]
   1.270 +  (binding [macro-fns {}
   1.271 +	    macro-symbols {}
   1.272 +	    protected-symbols #{}]
   1.273 +    (expand-all form)))