├── .gitignore ├── LICENSE ├── README.md ├── doc └── intro.md ├── project.clj ├── src └── metaclj │ ├── core.clj │ └── impl │ ├── env.clj │ ├── parse.clj │ ├── patch.clj │ └── transform.clj └── test └── metaclj └── core_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Meta-Clojure 2 | 3 | 4 | ## Overview 5 | 6 | Meta-Clojure provides staged compilation for Clojure. It includes a form of 7 | syntax quoting that is aware of both local environments and special-forms. 8 | Among other things, this makes many macros easier to write. Perhaps more 9 | importantly, it simplifies control over when code gets evaluated or compiled. 10 | 11 | ## Usage 12 | 13 | ```clojure 14 | (require '[metaclj.core :refer [defmeta defbn syntax] :as meta]) 15 | ``` 16 | 17 | ### Meta-Macros 18 | 19 | The `defmeta` form is analogous to `defmacro`, but is expected to return 20 | Syntax objects (forms plus their environments) instead of plain forms. 21 | 22 | ```clojure 23 | (defmeta my-if [test then else] 24 | (syntax (if test then else))) 25 | ``` 26 | 27 | Note that you don't need to unquote any of the parameters to `if`, since the 28 | `syntax` form is aware of the meta-macro's environment. 29 | 30 | ### Call-By-Name 31 | 32 | Since it's common for macros to have a body that always templates code with 33 | a syntax-quoter, the convenience macro `defbn` provides a way to create 34 | "call-by-name" macros: 35 | 36 | ```clojure 37 | (defbn my-if [test then else] 38 | (if test then else)) 39 | ``` 40 | 41 | Both versions of `my-if` have correct "lazy" behavior: they will only evaluate 42 | one arm of the conditional. 43 | 44 | ### Staged Compilation 45 | 46 | The `meta/do` macro will perform meta-quoting on zero or more forms, then 47 | evaluate each of them: 48 | 49 | ```clojure 50 | (meta/do 1 2 3) 51 | ;;=> 3 52 | ``` 53 | 54 | Combined with unquoting, this enables you to perform arbitrary computation at 55 | compile time: 56 | 57 | ```clojure 58 | (let [x 2 y 4] 59 | (meta/do ~(+ x y))) 60 | ;;=> 6 61 | ``` 62 | 63 | Unquoting is syntax aware and provides automatic splicing: 64 | 65 | ```clojure 66 | (let [args (syntax 2 4)] 67 | (meta/do ~(+ args))) 68 | ;;=> 6 69 | ``` 70 | 71 | You can use function expressions to defer computation. Note that the unquoted 72 | expression will still be evaluated at compile time: 73 | 74 | ```clojure 75 | (let [x 2 y 4] 76 | (meta/do (fn [] ~(+ x y)))) 77 | ;=> # 78 | ``` 79 | 80 | You can prove this to yourself by using `meta/translate`, which is a cousin 81 | of `macroexpand-all`: 82 | 83 | ```clojure 84 | (let [x 2 y 4] 85 | (meta/translate (fn [] ~(+ x y)))) 86 | => ((fn* ([] 6))) 87 | ``` 88 | 89 | Note that the returned value is wrapped in a seq, since Meta-Clojure uniformly 90 | supports multiple expressions with implicit splicing: 91 | 92 | ```clojure 93 | (let [x (syntax 2 3)] 94 | (meta/translate 1 x 4)) 95 | ;=> (1 2 3 4) 96 | ``` 97 | 98 | 99 | ## Status 100 | 101 | - The comments at the bottom of [core.clj](./src/metaclj/core.clj) and 102 | the code in [core_test.clj](./test/metaclj/core_test.clj) form my testbed. 103 | - Many known bugs and incomplete behavior. 104 | - Some special forms not yet supported: `case`, `deftype`, and `reify`. 105 | - No progress yet on [Exotypes][5] 106 | - Use of `clojure.core/eval` is unavoidable at the top level, but it could 107 | be compiled away for more interior forms. 108 | - Maybe someday I'll revive [EClj][4] and build its compiler on Meta-Clojure. 109 | 110 | 111 | ## References 112 | 113 | - [Multi-stage Programming][1] 114 | - [Terralang][2] 115 | - [MetaOCaml][3] 116 | - [EClj][4] 117 | - [Exotypes][5] 118 | 119 | 120 | ## License 121 | 122 | Copyright © 2016 Brandon Bloom 123 | 124 | Distributed under the Eclipse Public License either version 1.0 or (at 125 | your option) any later version. 126 | 127 | 128 | [1]: https://www.cs.rice.edu/~taha/MSP/ 129 | [2]: http://terralang.org/ 130 | [3]: http://okmij.org/ftp/ML/MetaOCaml.html 131 | [4]: https://github.com/brandonbloom/eclj 132 | [5]: http://terralang.org/pldi083-devito.pdf 133 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to metaclj 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) 4 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject metaclj "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.9.0-alpha15"] 7 | [backtick "0.3.0"]]) 8 | -------------------------------------------------------------------------------- /src/metaclj/core.clj: -------------------------------------------------------------------------------- 1 | (ns metaclj.core 2 | (:refer-clojure :exclude [eval compile]) 3 | (:require [metaclj.impl.env :refer [->Env]] 4 | [metaclj.impl.parse :refer [parse ->Syntax syntax?]] 5 | [metaclj.impl.transform :refer [transform-in]])) 6 | 7 | (defn eval [x] 8 | ;(fipp.clojure/pprint (transform-in (->Env *ns*) x)) 9 | (reduce (fn [_ x] (clojure.core/eval x)) 10 | nil 11 | (transform-in (->Env *ns*) x))) 12 | 13 | (defmacro local-env [] 14 | `(into (->Env ~*ns*) 15 | [~@(for [sym (keys &env)] 16 | [(list 'quote sym) sym])])) 17 | 18 | (defmacro syntax [& forms] 19 | `(->Syntax '~(vec forms) (local-env))) 20 | 21 | (defmacro translate [& forms] 22 | `(transform-in (->Env *ns*) (syntax ~@forms))) 23 | 24 | (defmacro do [& body] 25 | `(eval (syntax ~@body))) 26 | 27 | (defmacro defmeta [name & fn-tail] 28 | (let [make-binding (fn [param variadic?] 29 | (list `->Syntax 30 | (list (if variadic? `vec `vector) param) 31 | '&env)) 32 | make-bindings (fn [sig] 33 | (first 34 | (reduce (fn [[bindings variadic?] param] 35 | (if (= param '&) 36 | [bindings true] 37 | [(conj bindings param 38 | (make-binding param variadic?))])) 39 | [[] false] 40 | sig))) 41 | methods (if (vector? (first fn-tail)) [fn-tail] fn-tail) 42 | methods (for [[sig & body] methods] 43 | (list sig `(let [~@(make-bindings sig)] ~@body))) 44 | f `(fn [~'&form ~'&env] 45 | (apply (fn ~@methods) (next ~'&form))) 46 | ;_ (fipp.clojure/pprint f) 47 | f (clojure.core/eval f)] ;TODO: meta-eval here? 48 | `(defmacro ~(vary-meta name assoc :meta-macro f) [~'& ~'args] 49 | `(eval (~~f '~~'&form (local-env)))))) 50 | 51 | (defmacro defbn [name & fn-tail] 52 | (let [methods (if (vector? (first fn-tail)) [fn-tail] fn-tail)] 53 | `(defmeta ~name ~@(for [[args & body] methods] 54 | (list args (list* `syntax body)))))) 55 | 56 | (comment 57 | 58 | (require 'fipp.edn) 59 | (require 'fipp.clojure) 60 | (defmacro party [form] 61 | `(doseq [x# (transform-in (local-env) '~form)] 62 | (fipp.clojure/pprint x#))) 63 | 64 | (fipp.clojure/pprint (macroexpand-1 ' 65 | (defmeta blahblah 66 | ([foo] [foo]) 67 | ([foo & bar] [foo bar])) 68 | )) 69 | 70 | (fipp.clojure/pprint (macroexpand-1 ' 71 | (blahblah 1 2 3 4) 72 | )) 73 | 74 | (fipp.edn/pprint 75 | (let [x 1] (syntax x)) 76 | ) 77 | 78 | (let [x 1 79 | y [1 2 3]] 80 | (syntax 0)) 81 | 82 | (let [x 1 83 | y [1 2 3]] 84 | (syntax x y)) 85 | 86 | (party inc) 87 | (party #'inc) 88 | (let [x 1] (party (fn f [y] (+ x y)))) 89 | (let [x 1] (party (fn [y] (+ x y)))) 90 | (let [x 1] 91 | (party (letfn [(f [] (g x)) 92 | (g [] (inc x))] 93 | (g 5)))) 94 | (let [x (Exception. "OH NOEZ")] (party (throw x))) 95 | 96 | (deftype Box [x]) 97 | (let [typ Box, x 1] (party (new typ x))) 98 | 99 | (deftype Pair [x y]) 100 | (let [xy (syntax 1 2)] (party (new Pair xy))) 101 | 102 | (let [x (syntax 1 2)] (party (recur x))) 103 | 104 | (let [typ "java.util.regex.Pattern"] (party (clojure.core/import* typ))) 105 | 106 | (party (try)) 107 | (let [a 1, b ArithmeticException, c 2, d 3, e 4] 108 | (party (try a (catch b ex [ex c]) (catch :default ex d) (finally e)))) 109 | 110 | (party (declare x y z)) 111 | (let [x (syntax 1 2)] (party (def y x))) 112 | 113 | (let [x 5 y 2] 114 | (party (loop [x x, y y] (if (pos? x) (recur (dec x) (inc y)) y)))) 115 | 116 | (party (case 1 2 3 4)) ;XXX broken by transform loop 117 | 118 | (def ^:dynamic *x* 1) 119 | (let [y 3] (party (binding [*x* 2] (set! *x* y)))) 120 | 121 | (let [obj :bogus, x 1] (party (set! (.x obj) x))) 122 | 123 | (defprotocol Frobable (frob [this x])) 124 | (deftype Foo [] Frobable (frob [this x] x)) 125 | (let [x 1] (party (.frob (Foo.) x))) 126 | 127 | (let [x 2 y 4] 128 | ((compile (fn [] ~(+ x y))))) 129 | 130 | (let [x 2 y 4] 131 | (translate (fn [] ~(+ x y)))) 132 | 133 | 134 | ) 135 | -------------------------------------------------------------------------------- /src/metaclj/impl/env.clj: -------------------------------------------------------------------------------- 1 | (ns metaclj.impl.env 2 | (:require [metaclj.impl.patch :as patch]) 3 | (:import [clojure.lang Reflector])) 4 | 5 | 6 | (defrecord Env [namespace]) 7 | 8 | (defn static-invoke [class member & args] 9 | (if (zero? (count args)) 10 | (try 11 | (Reflector/getStaticField class member) 12 | (catch Exception e 13 | (Reflector/invokeStaticMethod 14 | class member clojure.lang.RT/EMPTY_ARRAY))) 15 | (Reflector/invokeStaticMethod class member (object-array args)))) 16 | 17 | (defn staticfn [class member] 18 | (fn [& args] 19 | (apply static-invoke class member args))) 20 | 21 | (defn lookup-var [ns sym] 22 | (try 23 | (if-let [x (ns-resolve ns sym)] 24 | (if (var? x) 25 | (if-let [patch (patch/vars x)] 26 | (lookup-var ns patch) 27 | {:origin :namespace :value x}) 28 | {:origin :host :value x}) 29 | {:origin :host :value (clojure.lang.RT/classForName (name sym))}) 30 | (catch ClassNotFoundException e 31 | nil))) 32 | 33 | ;;TODO: These should all be methods on IEnv. 34 | 35 | (defn -deref [env ref] 36 | (deref ref)) 37 | 38 | (defn -invoke [env f args] 39 | (apply f args)) 40 | 41 | (defn -resolve [env sym] 42 | (or (when-let [[_ value] (find env sym)] 43 | {:origin :locals :value value}) 44 | (lookup-var (:namespace env) sym) 45 | (when-let [ns (namespace sym)] 46 | (let [{:keys [value]} (lookup-var (:namespace env) (symbol ns)) 47 | n (name sym)] 48 | (when (instance? Class value) 49 | {:origin :host 50 | :value (try 51 | (.get (.getField value n) value) 52 | (catch NoSuchFieldException _ 53 | (staticfn value n)))}))))) 54 | 55 | ;XXX should the uses of *ns* below be (:namespace env) ? 56 | 57 | (defn -declare [env sym] 58 | (intern *ns* sym)) 59 | 60 | (defn -define [env sym value] 61 | (let [var (intern *ns* sym value)] 62 | (when (-> sym meta :dynamic) 63 | (.setDynamic var)) 64 | var)) 65 | 66 | (defn -new [env class args] 67 | (Reflector/invokeConstructor class (object-array args))) 68 | 69 | (defn -interop [env static? object member args] 70 | (let [s (str member) 71 | s (if (.startsWith s "-") 72 | (apply str (next s)) 73 | s)] 74 | (if static? 75 | (apply static-invoke object s args) 76 | (if (zero? (count args)) 77 | (Reflector/invokeNoArgInstanceMember object s) 78 | (Reflector/invokeInstanceMember s object (object-array args)))))) 79 | 80 | (defn -assign-var [env var value] 81 | (var-set var value)) 82 | 83 | (defn assign-field [env object field value] ;TODO: Test this. 84 | (let [field (name field)] 85 | (if (instance? Class object) 86 | (Reflector/setStaticField object field value) 87 | (Reflector/setInstanceField object field value)))) 88 | 89 | (defn -import [env sym] 90 | (.importClass *ns* (clojure.lang.RT/classForName (name sym)))) 91 | 92 | (defn -reify [env interfaces methods] 93 | (clojure.core/eval 94 | `(reify* ~interfaces 95 | ~@((for [[name args & body] methods 96 | :let [expr `'(do ~@body) 97 | denv `(-> ~env ~@(for [arg args] 98 | `(assoc '~arg ~arg)))]] 99 | (list name args `(eclj.core/eval ~expr ~denv))))))) 100 | 101 | (defn -deftype [env tagname classname fields implements methods] 102 | (clojure.core/eval 103 | `(deftype* ~tagname ~classname ~fields :implements ~implements 104 | ~@(for [[name args & body] methods 105 | :let [params (repeatedly (count args) gensym) 106 | this (first params) 107 | getters (map #(list (symbol (str ".-" %)) this) fields) 108 | expr `'(eclj.core/symbol-macrolet 109 | [~@(interleave fields getters)] 110 | (let [~@(interleave args params)] 111 | ~@body)) 112 | denv `(-> ~env 113 | ~@(for [param params] 114 | `(assoc '~param ~param)))]] 115 | (list name (vec params) `(eclj.core/eval ~expr ~denv)))))) 116 | -------------------------------------------------------------------------------- /src/metaclj/impl/parse.clj: -------------------------------------------------------------------------------- 1 | (ns metaclj.impl.parse) 2 | 3 | ;TODO: namespaced symbols can't be shadowed; hence eclj.env/patches 4 | ;TODO: validation conditions. 5 | ; ie raise error for (var inc inc), (quote x x), odd number bindings, etc 6 | 7 | (defprotocol Form 8 | (-parse [expr env])) 9 | 10 | (defrecord Syntax [forms env] 11 | Form 12 | (-parse [x env] 13 | x)) 14 | 15 | (defn syntax? [x] 16 | (instance? Syntax x)) 17 | 18 | (defn head [x] 19 | (if (syntax? x) 20 | :syntax 21 | (:head x))) 22 | 23 | (defn parse [x env] 24 | (-parse x env)) 25 | 26 | (defn parse-meta [form env] 27 | (when-let [metadata (meta form)] 28 | {:head :meta :form form :env env 29 | :expr (with-meta form nil) :meta metadata})) 30 | 31 | (defn parse-constant [x env] 32 | (or (parse-meta x env) 33 | {:head :constant :form x :env env :value x})) 34 | 35 | (defn parse-collection [coll env] 36 | (or (parse-meta coll env) 37 | {:head :collection :form coll :env env :coll coll})) 38 | 39 | (doseq [t [nil java.lang.Object]] 40 | (extend t Form {:-parse parse-constant})) 41 | 42 | (defmulti parse-seq (fn [xs env] (first xs))) 43 | 44 | (defn parse-invoke [[f & args :as form] env] 45 | {:head :invoke :form form :env env :f f :args args}) 46 | 47 | (extend-protocol Form 48 | 49 | clojure.lang.Var 50 | (-parse [v env] 51 | (let [{:keys [name ns]} (meta v) 52 | sym (symbol (str (ns-name ns)) (clojure.core/name name))] 53 | (parse-seq (list 'var sym) env))) 54 | 55 | clojure.lang.Symbol 56 | (-parse [sym env] 57 | {:head :name :form sym :env env :sym sym}) 58 | 59 | clojure.lang.ISeq 60 | (-parse [xs env] 61 | (cond 62 | (empty? xs) (parse-constant xs env) 63 | (symbol? (first xs)) (parse-seq xs env) 64 | :else (parse-invoke xs env))) 65 | 66 | clojure.lang.AMapEntry 67 | (-parse [kvp env] 68 | (parse-collection (vec kvp) env)) 69 | 70 | ) 71 | 72 | (doseq [t [clojure.lang.PersistentArrayMap 73 | clojure.lang.PersistentHashMap 74 | clojure.lang.PersistentHashSet 75 | clojure.lang.PersistentQueue 76 | clojure.lang.PersistentTreeMap 77 | clojure.lang.PersistentTreeSet 78 | clojure.lang.PersistentVector]] 79 | (extend t Form {:-parse parse-collection})) 80 | 81 | (defn expand-dot [[head & tail :as form] env] 82 | (let [s (str head)] 83 | (cond 84 | (= s "..") nil ;XXX Special cases the `..` macro, but could be others. 85 | (.endsWith s ".") (let [class (symbol (apply str (butlast s)))] 86 | {:head :new :form form :env env 87 | :class class :args (vec tail)}) 88 | (.startsWith s ".") (let [member (symbol (apply str (next s))) 89 | [obj & args] tail] 90 | {:head :interop :form form :env env 91 | :target obj :member member :args (vec args)})))) 92 | 93 | (defmethod parse-seq :default 94 | [form env] 95 | (or (and (symbol? (first form)) (expand-dot form env)) 96 | {:head :invoke :form form :env env 97 | :f (first form) :args (vec (rest form))})) 98 | 99 | (defmethod parse-seq 'if 100 | [[_ test then else :as form] env] 101 | {:head :if :form form :env env 102 | :test test :then then :else else}) 103 | 104 | (defmethod parse-seq 'var 105 | [[_ sym :as form] env] 106 | {:head :var :form form :env env :sym sym}) 107 | 108 | (defmethod parse-seq 'do 109 | [[_ & body :as form] env] 110 | (if (seq body) 111 | (let [v (vec body)] 112 | {:head :do :form form :env env 113 | :statements (pop v) :ret (peek v)}) 114 | {:head :constant :form form :env env :value nil})) 115 | 116 | (defmethod parse-seq 'quote 117 | [[_ value :as form] env] 118 | {:head :constant :form form :env env :value value}) 119 | 120 | (defn implicit-do [body] 121 | (case (count (take 2 body)) 122 | 0 nil 123 | 1 (first body) 124 | (list* 'do body))) 125 | 126 | (defmethod parse-seq 'let* 127 | [[_ bindings & body :as form] env] 128 | {:head :let :form form :env env 129 | :bindings (mapv (fn [[name init]] 130 | (when (namespace name) 131 | (throw (Exception. 132 | (str "Can't let qualified name: " name)))) 133 | {:name name :init init}) 134 | (partition 2 bindings)) 135 | :expr (implicit-do body)}) 136 | 137 | (defn parse-method [params body] 138 | ;;TODO: validate signature. 139 | (let [[fixed [_ variadic]] (split-with (complement '#{&}) params)] 140 | {:fixed (vec fixed) 141 | :variadic variadic 142 | :expr (implicit-do body)})) 143 | 144 | (defn parse-fn [[_ & fn-tail] env] 145 | ;;TODO: validate methods. 146 | (let [[name impl] (if (symbol? (first fn-tail)) 147 | [(first fn-tail) (next fn-tail)] 148 | [nil fn-tail]) 149 | methods (for [[sig & body] (if (vector? (first impl)) [impl] impl)] 150 | (parse-method sig body))] 151 | {:name name :env env :methods methods})) 152 | 153 | (defmethod parse-seq 'fn* 154 | [form env] 155 | (or (parse-meta form env) 156 | (merge {:head :fn :form form :env env} 157 | (parse-fn form env)))) 158 | 159 | (defmethod parse-seq 'letfn* 160 | [[_ bindings & body :as form] env] 161 | {:head :letfn :form form :env env 162 | :bindings (->> (next bindings) 163 | (take-nth 2) 164 | (map (comp (juxt :name identity) #(parse-fn % env))) 165 | vec) 166 | :expr (implicit-do body)}) 167 | 168 | (defmethod parse-seq 'try 169 | [[_ & body :as form] env] 170 | (let [catch? (every-pred seq? #(= (first %) 'catch)) 171 | default? (every-pred catch? #(= (second %) :default)) 172 | finally? (every-pred seq? #(= (first %) 'finally))] 173 | (loop [{:keys [state forms body] :as parser} 174 | {:state :start :forms body :body [] 175 | :catches [] :default nil :finally nil}] 176 | (if-let [[form & forms*] forms] 177 | (let [parser* (assoc parser :forms forms*)] 178 | (case state 179 | :start 180 | (cond 181 | (catch? form) (recur (assoc parser :state :catches)) 182 | (finally? form) (recur (assoc parser :state :finally)) 183 | :else (recur (update-in parser* [:body] conj form))) 184 | :catches 185 | (cond 186 | (default? form) 187 | (let [[_ _ name & dbody] form 188 | default {:name name :expr (implicit-do dbody)}] 189 | (recur (assoc parser* :default default :state :finally))) 190 | (catch? form) 191 | (let [[_ type name & cbody] form 192 | catch {:type type :name name 193 | :expr (implicit-do cbody)}] 194 | (recur (update-in parser* [:catches] conj catch))) 195 | (finally? form) 196 | (recur (assoc parser :state :finally)) 197 | :else 198 | (throw (Exception. "Invalid try form"))) 199 | :finally 200 | (let [[_ & fbody] form 201 | finally (implicit-do fbody)] 202 | (recur (assoc parser* :finally finally :state :done))) 203 | :done 204 | (throw (Exception. "Unexpected form after finally")))) 205 | (-> parser 206 | (select-keys [:catches :default :finally]) 207 | (assoc :head :try :form form :env env 208 | :try (-> parser :body implicit-do))))))) 209 | 210 | (defmethod parse-seq 'throw 211 | [[_ expr :as form] env] 212 | {:head :throw :form form :env env :expr expr}) 213 | 214 | (defmethod parse-seq 'def 215 | [[_ & body :as form] env] 216 | (let [[sym doc expr] (case (count body) 217 | 1 [(first body)] 218 | 2 [(first body) nil (second body)] 219 | 3 body) 220 | doc (or doc (-> sym meta :doc)) 221 | sym (vary-meta sym assoc :doc doc)] 222 | (merge 223 | {:sym sym :form form :env env} 224 | (if (> (count body) 1) 225 | {:head :define :expr expr} 226 | {:head :declare})))) 227 | 228 | (defmethod parse-seq 'new 229 | [[_ class & args :as form] env] 230 | {:head :new :form form :env env :class class :args (vec args)}) 231 | 232 | (defmethod parse-seq '. 233 | [[_ target & body :as form] env] 234 | (let [[member args] (if (and (= (count body) 1) (seq? (first body))) 235 | [(ffirst body) (nfirst body)] 236 | [(first body) (next body)]) 237 | ;; syntax-quote may non-sensically qualify member symbols. 238 | member (symbol (name member))] 239 | {:head :interop :form form :env env 240 | :target target :member member :args (vec args)})) 241 | 242 | (defmethod parse-seq 'set! 243 | [[_ location expr :as form] env] 244 | ;;TODO just :head :assign 245 | (if (symbol? location) 246 | {:head :assign-var :form form :env env 247 | :name location :expr expr} 248 | (let [[field object] location] 249 | ;;TODO: Validate location. 250 | {:head :assign-field :form form :env env 251 | :object object 252 | :field (symbol (apply str (next (str field)))) 253 | :expr expr}))) 254 | 255 | (defmethod parse-seq 'loop* 256 | [[_ bindings & body :as form] env] 257 | (let [bindings (->> bindings 258 | (partition 2) 259 | (mapv (fn [[name init]] 260 | {:name name 261 | :init init})))] 262 | {:head :loop :form form :env env 263 | :bindings bindings :expr (implicit-do body)})) 264 | 265 | (defmethod parse-seq 'recur 266 | [[_ & args :as form] env] 267 | {:head :recur :form form :env env :args (vec args)}) 268 | 269 | (defmethod parse-seq 'clojure.core/import* 270 | [[_ sym :as form] env] 271 | {:head :import :form form :env env :sym sym}) 272 | 273 | (defmethod parse-seq 'metaclj.impl.patch/case* 274 | [[_ expr cases default :as form] env] 275 | {:head :case :form form :env env 276 | :expr expr :cases cases :default default}) 277 | 278 | (defmethod parse-seq 'reify* 279 | [[_ interfaces & methods :as form] env] 280 | {:head :reify :form form :env env 281 | :interfaces interfaces :methods methods}) 282 | 283 | ;;XXX This naive parsing assumes no deftype options & only internal usage. 284 | (defmethod parse-seq 'deftype* 285 | [[_ tagname classname fields _ implements & methods :as form] env] 286 | {:head :deftype :form form :env env :tagname tagname :classname classname 287 | :fields fields :implements implements :methods methods}) 288 | 289 | (defmethod parse-seq 'clojure.core/unquote 290 | [[_ expr :as form] env] 291 | {:head :unquote :form form :env env :expr expr}) 292 | -------------------------------------------------------------------------------- /src/metaclj/impl/patch.clj: -------------------------------------------------------------------------------- 1 | (ns metaclj.impl.patch 2 | ;; This seems to confuse vim-fireplace. Use :Require to reload file. 3 | (:refer-clojure :exclude [case])) 4 | 5 | (def vars {#'clojure.core/case 'metaclj.impl.patch/case 6 | ;;XXX find and fix occurrences of "eclj". 7 | #'clojure.core/ns 'eclj.core/ns 8 | #'clojure.core/deftype 'eclj.core/deftype 9 | #'clojure.core/defrecord 'eclj.core/defrecord 10 | #'clojure.core/defprotocol 'eclj.core/defprotocol}) 11 | 12 | (declare case*) 13 | 14 | (defmacro case 15 | [e & clauses] 16 | (let [default? (odd? (count clauses))] 17 | ;;TODO: Handle documented list behavior. 18 | `(metaclj.impl.patch/case* ~e 19 | ~(->> (if default? (butlast clauses) clauses) 20 | (partition 2) (map vec) (into {})) 21 | ~(if default? 22 | (last clauses) 23 | `(throw (ex-info (str "No clause matching") 24 | {:error :no-matching-clause})))))) 25 | -------------------------------------------------------------------------------- /src/metaclj/impl/transform.clj: -------------------------------------------------------------------------------- 1 | (ns metaclj.impl.transform 2 | (:require [metaclj.impl.env :as env] 3 | [metaclj.impl.parse :refer [parse head syntax?]])) 4 | 5 | (defn rename [sym] 6 | (gensym (str sym "$"))) 7 | 8 | (defn meta-macro? [{:keys [origin value]}] 9 | (and (= origin :namespace) (-> value meta :meta-macro))) 10 | 11 | (defn macro? [{:keys [origin value]}] 12 | (and (= origin :namespace) (-> value meta :macro))) 13 | 14 | (defmulti transform #'head) 15 | 16 | (defn transform-in [env x] 17 | (transform (parse x env))) 18 | 19 | (defn do-in [env x] 20 | (let [xs (transform-in env x)] 21 | (case (count xs) 22 | 0 nil 23 | 1 (first xs) 24 | (list* 'do xs)))) 25 | 26 | (defmethod transform :syntax [{:keys [forms env]}] 27 | (mapcat #(transform-in env %) forms)) 28 | 29 | (defmethod transform :constant [{:keys [value]}] 30 | [value]) 31 | 32 | (defmethod transform :name [{:keys [env sym]}] 33 | (let [{:keys [origin value] :as resolved} (env/-resolve env sym)] 34 | (if (macro? resolved) 35 | (throw (ex-info "Can't take value of a macro" {:sym sym :env env})) 36 | (let [x (case origin 37 | nil (throw (ex-info "Undefined" {:sym sym})) 38 | :locals value 39 | :host value 40 | :namespace @value 41 | (throw (ex-info "Unknown origin" {:origin origin})))] 42 | (if (syntax? x) 43 | (transform x) 44 | [x]))))) 45 | 46 | (defmethod transform :do [{:keys [env statements ret]}] 47 | [(concat ['do] 48 | (mapcat #(transform-in env %) statements) 49 | (transform-in env ret))]) 50 | 51 | (defn transform-items [coll env] 52 | (into (empty coll) (mapcat #(transform-in env %) coll))) 53 | 54 | (defmethod transform :collection [{:keys [coll env]}] 55 | [(transform-items coll env)]) 56 | 57 | (defn splice-syntax [form env] 58 | (list* (first form) 59 | (mapcat (fn [x] 60 | (let [y (if (symbol? x) (:value (env/-resolve env x)) x)] 61 | (if (syntax? y) 62 | (mapcat #(transform-in (:env y) %) (:forms y)) 63 | [x]))) 64 | (next form)))) 65 | 66 | (defmethod transform :invoke [{:keys [env f args form]}] 67 | (if (symbol? f) 68 | (let [{:keys [value] :as resolved} (env/-resolve env f)] 69 | (cond 70 | (meta-macro? resolved) 71 | ,,(let [mac (-> value meta :meta-macro) 72 | subst (mac (splice-syntax form env) env)] 73 | (mapcat #(transform-in env %) (transform-in env subst))) 74 | (macro? resolved) 75 | ,,(let [subst (apply value (list* form env (next form)))] 76 | (mapcat #(transform-in env %) (transform-in env subst))) 77 | ;XXX (expansion? value) (transform (assoc ast :f (:expr value))) 78 | :else [(list* value (mapcat #(transform-in env %) args))])) 79 | [(concat (transform-in env f) (mapcat #(transform-in env %) args))])) 80 | 81 | (defmethod transform :var [{:keys [sym]}] 82 | [(list 'var sym)]) 83 | 84 | (defmethod transform :let 85 | [{:keys [bindings expr env]}] 86 | (let [[env bindings] (reduce (fn [[env bindings] {:keys [name init]}] 87 | (let [sym (rename name)] 88 | [(assoc env name sym) 89 | (conj bindings sym (do-in env init))])) 90 | [env []] 91 | bindings)] 92 | [(list* 'let* bindings (transform-in env expr))])) 93 | 94 | (defmethod transform :if 95 | [{:keys [test then else env]}] 96 | [(list* 'if (mapcat #(transform-in env %) [test then else]))]) 97 | 98 | (defmethod transform :meta 99 | [{:keys [form meta env]}] 100 | ;XXX use meta 101 | (transform-in env (with-meta form nil))) 102 | 103 | (defn transform-method [{:keys [fixed variadic expr]} env] 104 | (let [gfixed (map rename fixed) 105 | gvariadic (when variadic (rename variadic)) 106 | params (concat fixed (when variadic [variadic])) 107 | gparams (concat gfixed (when gvariadic [gvariadic])) 108 | sig (vec (concat gfixed (when gvariadic ['& gvariadic]))) 109 | env (into env (map vector params gparams))] 110 | (list* sig (transform-in env expr)))) 111 | 112 | (defmethod transform :fn 113 | [{:keys [name methods env]}] 114 | (let [code ['fn*] 115 | gname (when name (rename name)) 116 | [code env] (if name 117 | [(conj code name) (assoc env name gname)] 118 | [code env])] 119 | [(concat code (map #(transform-method % env) methods))])) 120 | 121 | (defmethod transform :letfn 122 | [{:keys [bindings expr env]}] 123 | (let [env (into env (for [[name _] bindings] 124 | [name (rename name)])) 125 | fns (mapv (fn [[name f]] 126 | (list* `fn (get env name) 127 | (map #(transform-method % env) 128 | (:methods f)))) 129 | bindings) 130 | bindings (mapcat (fn [[name _] f] [name f]) bindings fns)] 131 | [(list* 'letfn* (vec bindings) (transform-in env expr))])) 132 | 133 | (defmethod transform :throw 134 | [{:keys [expr env]}] 135 | [(list 'throw (do-in env expr))]) 136 | 137 | (defmethod transform :new 138 | [{:keys [class args env]}] 139 | [(list* 'new (do-in env class) (mapcat #(transform-in env %) args))]) 140 | 141 | (defmethod transform :recur 142 | [{:keys [args env]}] 143 | [(list* 'recur (mapcat #(transform-in env %) args))]) 144 | 145 | (defmethod transform :import 146 | [{:keys [sym env]}] 147 | [(list* 'clojure.core/import* (transform-in env sym))]) 148 | 149 | (defmethod transform :try 150 | [{:keys [try catches default finally env]}] 151 | [(concat ['try] (transform-in env try) 152 | (for [{:keys [type name expr]} catches 153 | :let [rn (rename name)]] 154 | (list* 'catch (do-in env type) rn 155 | (transform-in (assoc env name rn) expr))) 156 | (when-let [{:keys [name expr]} default] 157 | (let [rn (rename name)] 158 | [(list* 'catch `Exception rn 159 | (transform-in (assoc env name rn) expr))])) 160 | (when finally 161 | [(list* 'finally (transform-in env finally))]))]) 162 | 163 | (defmethod transform :declare 164 | [{:keys [sym]}] 165 | [(list 'def sym)]) 166 | 167 | (defmethod transform :define 168 | [{:keys [sym expr env]}] 169 | [(list 'def sym (do-in env expr))]) 170 | 171 | (defmethod transform :loop 172 | [{:keys [bindings expr env]}] 173 | (let [[bindings env] (reduce (fn [[bindings env] {:keys [name init]}] 174 | (let [rn (rename name)] 175 | [(conj bindings rn (do-in env init)) 176 | (assoc env name rn)])) 177 | [[] env] 178 | bindings)] 179 | [(list* 'loop* bindings (transform-in env expr))])) 180 | 181 | (defmethod transform :case 182 | [{:keys [expr cases default env]}] 183 | [(concat [`case] 184 | [(do-in env expr)] 185 | (mapcat (fn [[val expr]] 186 | [val (do-in env expr)]) 187 | cases) 188 | [(do-in env default)])]) 189 | 190 | (defmethod transform :assign-var 191 | [{:keys [name expr env]}] 192 | [(list 'set! name (do-in env expr))]) 193 | 194 | (defmethod transform :assign-field 195 | [{:keys [object field expr env]}] 196 | [(list 'set! (list '. (do-in env object) field) (do-in env expr))]) 197 | 198 | (defmethod transform :interop 199 | [{:keys [target member args env]}] 200 | [(list* '. (do-in env target) member (mapcat #(transform-in env %) args))]) 201 | 202 | (defmethod transform :unquote 203 | [{:keys [expr env]}] 204 | (map clojure.core/eval (transform-in env expr))) 205 | 206 | ;TODO :reify 207 | ;TODO :deftype 208 | -------------------------------------------------------------------------------- /test/metaclj/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns metaclj.core-test 2 | (:require [clojure.test :refer :all] 3 | [metaclj.core :refer :all] 4 | [metaclj.impl.env :refer [->Env]])) 5 | 6 | (deftest env-test 7 | (is (= (local-env) 8 | (->Env *ns*))) 9 | (is (= (let [x 1] (local-env)) 10 | (merge (->Env *ns*) '{x 1}))) 11 | (is (= (let [x 1 x 2] (local-env)) 12 | (merge (->Env *ns*) '{x 2}))) 13 | ) 14 | 15 | (defbn dotwice [expr] 16 | expr 17 | expr) 18 | 19 | (defbn my-if [test then else] 20 | (if test then else)) 21 | 22 | (defbn vector-bn [& args] 23 | [args]) 24 | 25 | (defbn my-and 26 | ([] true) 27 | ([x] x) 28 | ([x & next] 29 | (let [y x] 30 | (if y (my-and next) y)))) 31 | 32 | (deftest by-name-test 33 | 34 | (is (= "11" (with-out-str (dotwice (pr 1))))) 35 | 36 | (is (= 1 (my-if true 1 2))) 37 | (is (= "1" (with-out-str (my-if true (pr 1) (pr 2))))) 38 | (is (= 2 (my-if false 1 2))) 39 | (is (= "2" (with-out-str (my-if false (pr 1) (pr 2))))) 40 | 41 | (is (= (vector) (vector-bn))) 42 | (is (= (vector 1 2 3) (vector-bn 1 2 3))) 43 | 44 | (is (= true (my-and))) 45 | (is (= 1 (my-and 1))) 46 | (is (= 2 (my-and 1 2))) 47 | (is (= 3 (my-and 1 2 3))) 48 | (is (= 4 (my-and 1 2 3 4))) 49 | (is (= false (my-and 1 false 3 4))) 50 | (is (= nil (my-and 1 2 nil 4))) 51 | 52 | ) 53 | 54 | ;;XXX some stuff is being transformed multiple times, as evidenced by 55 | ;; multiple dollar signs in symbols. Generated symbols are being passed 56 | ;; to gensym. Figure out why and prevent this from happening. 57 | --------------------------------------------------------------------------------