├── .gitignore ├── .travis.yml ├── README.md ├── docs └── riddley.jpg ├── project.clj ├── src └── riddley │ ├── Util.java │ ├── compiler.clj │ └── walk.clj └── test └── riddley └── walk_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 | push 11 | /doc 12 | .DS_Store* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | script: lein do clean, test 3 | jdk: 4 | - openjdk8 -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Walker is my name 2 | and I am the same. 3 | Riddley Walker. 4 | Walking my riddels 5 | where ever theyve took me 6 | and walking them now 7 | on this paper the same. 8 | 9 | from [Riddley Walker](http://en.wikipedia.org/wiki/Riddley_Walker) by Russell Hoban 10 | 11 | --- 12 | 13 | Code may be data, but only some of that data is executable. If we want to perform a pervasive code transformation, using something like `clojure.walk` presents a few problems: 14 | 15 | * binding forms are treated the same as actual expressions 16 | * `clojure.walk/macroexpand-all` will pass in a nil `&env` to all macros 17 | * macroexpansion doesn't expand inlined functions 18 | 19 | This means that transforms that we intend to apply to expressions may have unintended consequences on a `fn`, `let`, or `case` form. It also means that any macro which relies on `&env` will not compose with our transformation. Finally, if inlined functions aren't expanded, certain transformations will break. 20 | 21 | ### usage 22 | 23 | [![Build Status](https://travis-ci.org/ztellman/riddley.png?branch=master)](https://travis-ci.org/ztellman/riddley) 24 | 25 | ```clj 26 | [riddley "0.2.0"] 27 | ``` 28 | 29 | Riddley provides a correct `riddley.walk/macroexpand-all`, which preserves the binding information in `&env` and expands inlined functions, and `riddley.walk/walk-exprs`, which is a general mechanism for code walking and transformation. 30 | 31 | `walk-exprs` takes two arguments, a `predicate` for whether it should transform the sub-form, and a `handler` for doing the transformation. 32 | 33 | ```clj 34 | riddley.walk> (walk-exprs number? inc '(let [n 1] (+ n 1))) 35 | (let* [n 2] (. clojure.lang.Numbers (add n 2))) 36 | ``` 37 | 38 | Notice that `walk-exprs` implicitly macroexpands the form, including the inline form for `+`. Unlike `clojure.walk`, if `handler` is called, sub-forms will not be walked. The handler function is responsible for recursively calling `walk-exprs` on the form it's handed. 39 | 40 | Access to `&env` is available via `(riddley.compiler/locals)` if you need it as part of your transformation. 41 | 42 | Full documentation can be found [here](http://aleph.io/codox/riddley/). 43 | 44 | ### license 45 | 46 | Copyright © 2013 Zachary Tellman 47 | 48 | Distributed under the MIT License. 49 | -------------------------------------------------------------------------------- /docs/riddley.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ztellman/riddley/b5fe7c63ac9eaf55a23a855796d9bb7ee5f24567/docs/riddley.jpg -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject riddley "0.2.0" 2 | :description "code-walking without caveats" 3 | :license {:name "MIT License" 4 | :url "http://opensource.org/licenses/MIT"} 5 | :dependencies [] 6 | :plugins [[lein-codox "0.9.4"]] 7 | :codox {:src-dir-uri "https://github.com/ztellman/riddley/tree/master/" 8 | :src-linenum-anchor-prefix "L" 9 | :defaults {:doc/format :markdown} 10 | :include [riddley.walk riddley.compiler] 11 | :output-dir "doc"} 12 | :profiles {:provided {:dependencies [[org.clojure/clojure "1.8.0"]]}} 13 | :java-source-paths ["src/riddley"] 14 | :javac-options ["-target" "1.6" "-source" "1.6"]) 15 | -------------------------------------------------------------------------------- /src/riddley/Util.java: -------------------------------------------------------------------------------- 1 | package riddley; 2 | 3 | import clojure.lang.Symbol; 4 | import clojure.lang.Compiler; 5 | 6 | public class Util { 7 | 8 | public static Compiler.LocalBinding localBinding(int num, Symbol sym, Symbol tag, Object form) { 9 | return new Compiler.LocalBinding(num, sym, tag, Compiler.analyze(Compiler.C.EXPRESSION, form), false, null); 10 | } 11 | 12 | public static Compiler.LocalBinding localArgument(int num, Symbol sym, Symbol tag) { 13 | return new Compiler.LocalBinding(num, sym, tag, null, true, null); 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /src/riddley/compiler.clj: -------------------------------------------------------------------------------- 1 | (ns riddley.compiler 2 | (:import 3 | [clojure.lang 4 | Var 5 | Compiler 6 | Compiler$ObjMethod 7 | Compiler$ObjExpr] 8 | [riddley 9 | Util])) 10 | 11 | (defn- stub-method [] 12 | (proxy [Compiler$ObjMethod] [(Compiler$ObjExpr. nil) nil])) 13 | 14 | (defn tag-of 15 | "Returns a symbol representing the tagged class of the symbol, or `nil` if none exists." 16 | [x] 17 | (when-let [tag (-> x meta :tag)] 18 | (let [sym (symbol 19 | (if (instance? Class tag) 20 | (.getName ^Class tag) 21 | (name tag)))] 22 | (when-not (= 'java.lang.Object sym) 23 | sym)))) 24 | 25 | (let [n (atom 0)] 26 | (defn- local-id [] 27 | (swap! n inc))) 28 | 29 | (defn locals 30 | "Returns the local binding map, equivalent to the value of `&env`." 31 | [] 32 | (when (.isBound Compiler/LOCAL_ENV) 33 | @Compiler/LOCAL_ENV)) 34 | 35 | (defmacro with-base-env [& body] 36 | `(binding [*warn-on-reflection* false] 37 | (with-bindings (if (locals) 38 | {} 39 | {Compiler/LOCAL_ENV {}}) 40 | ~@body))) 41 | 42 | (defmacro with-lexical-scoping 43 | "Defines a lexical scope where new locals may be registered." 44 | [& body] 45 | `(with-bindings {Compiler/LOCAL_ENV (locals)} 46 | ~@body)) 47 | 48 | (defmacro with-stub-vars [& body] 49 | `(with-bindings {Compiler/CLEAR_SITES nil 50 | Compiler/METHOD (stub-method)} 51 | ~@body)) 52 | 53 | ;; if we don't do this in Java, the checkcasts emitted by Clojure cause an 54 | ;; IllegalAccessError on Compiler$Expr. Whee. 55 | (defn register-local 56 | "Registers a locally bound variable `v`, which is being set to form `x`." 57 | [v x] 58 | (with-stub-vars 59 | (.set ^Var Compiler/LOCAL_ENV 60 | 61 | ;; we want to allow metadata on the symbols to persist, so remove old symbols first 62 | (-> (locals) 63 | (dissoc v) 64 | (assoc v (try 65 | (Util/localBinding (local-id) v (tag-of v) x) 66 | (catch Exception _ 67 | ::analyze-failure))))))) 68 | 69 | (defn register-arg 70 | "Registers a function argument `x`." 71 | [x] 72 | (with-stub-vars 73 | (.set ^Var Compiler/LOCAL_ENV 74 | (-> (locals) 75 | (dissoc x) 76 | (assoc x (Util/localArgument (local-id) x (tag-of x))))))) 77 | 78 | 79 | 80 | -------------------------------------------------------------------------------- /src/riddley/walk.clj: -------------------------------------------------------------------------------- 1 | (ns riddley.walk 2 | (:refer-clojure :exclude [macroexpand]) 3 | (:require 4 | [riddley.compiler :as cmp])) 5 | 6 | (defn macroexpand 7 | "Expands both macros and inline functions. Optionally takes a `special-form?` predicate which 8 | identifies first elements of expressions that shouldn't be macroexpanded, and honors local 9 | bindings." 10 | ([x] 11 | (macroexpand x nil)) 12 | ([x special-form?] 13 | (cmp/with-base-env 14 | (if (seq? x) 15 | (let [frst (first x)] 16 | 17 | (if (or 18 | (and special-form? (special-form? frst)) 19 | (contains? (cmp/locals) frst)) 20 | 21 | ;; might look like a macro, but for our purposes it isn't 22 | x 23 | 24 | (let [x' (macroexpand-1 x)] 25 | (if-not (identical? x x') 26 | (macroexpand x' special-form?) 27 | 28 | ;; if we can't macroexpand any further, check if it's an inlined function 29 | (if-let [inline-fn (and (seq? x') 30 | (symbol? (first x')) 31 | (-> x' meta ::transformed not) 32 | (or 33 | (-> x' first resolve meta :inline-arities not) 34 | ((-> x' first resolve meta :inline-arities) 35 | (count (rest x')))) 36 | (-> x' first resolve meta :inline))] 37 | (let [x'' (with-meta (apply inline-fn (rest x')) (meta x'))] 38 | (macroexpand 39 | ;; unfortunately, static function calls can look a lot like what we just 40 | ;; expanded, so prevent infinite expansion 41 | (if (= '. (first x'')) 42 | (with-meta 43 | (concat (butlast x'') 44 | [(if (instance? clojure.lang.IObj (last x'')) 45 | (with-meta (last x'') 46 | (merge 47 | (meta (last x'')) 48 | {::transformed true})) 49 | (last x''))]) 50 | (meta x'')) 51 | x'') 52 | special-form?)) 53 | x'))))) 54 | x)))) 55 | 56 | ;;; 57 | 58 | (def ^:private special-forms 59 | (into #{} (keys (. clojure.lang.Compiler specials)))) 60 | 61 | (defn- special-meta [[op & body]] 62 | (list* (vary-meta op assoc ::special true) body)) 63 | 64 | (defn- do-handler [f [_ & body]] 65 | (list* 'do 66 | (doall 67 | (map f body)))) 68 | 69 | (defn- fn-handler [f x] 70 | (let [prelude (take-while (complement sequential?) x) 71 | remainder (drop (count prelude) x) 72 | remainder (if (vector? (first remainder)) 73 | (list remainder) remainder) 74 | body-handler (fn [x] 75 | (cmp/with-lexical-scoping 76 | (doseq [arg (first x)] 77 | (cmp/register-arg arg)) 78 | (doall 79 | (list* (first x) 80 | (map f (rest x))))))] 81 | 82 | (cmp/with-lexical-scoping 83 | 84 | ;; register a local for the function, if it's named 85 | (when-let [nm (second prelude)] 86 | (cmp/register-local nm 87 | (list* 'fn* nm 88 | (map #(take 1 %) remainder)))) 89 | 90 | (concat 91 | prelude 92 | (if (seq? (first remainder)) 93 | (doall (map body-handler remainder)) 94 | [(body-handler remainder)]))))) 95 | 96 | (defn- def-handler [f x] 97 | (let [[_ n & r] x] 98 | (cmp/with-lexical-scoping 99 | (cmp/register-local n '()) 100 | (list* 'def (f n) (doall (map f r)))))) 101 | 102 | (defn- let-bindings [f x recursive?] 103 | (let [pairs (partition-all 2 x)] 104 | (when recursive? 105 | (doall (map (fn [[k v]] (cmp/register-local k nil)) pairs))) 106 | (->> pairs 107 | (mapcat 108 | (fn [[k v]] 109 | (let [[k v] [k (f v)]] 110 | (cmp/register-local k v) 111 | [k v]))) 112 | vec))) 113 | 114 | (defn- reify-handler [f x] 115 | (let [[_ classes & fns] x] 116 | (list* 'reify* classes 117 | (doall 118 | (map 119 | (fn [[nm args & body]] 120 | (cmp/with-lexical-scoping 121 | (doseq [arg args] 122 | (cmp/register-arg arg)) 123 | (list* nm args (doall (map f body))))) 124 | fns))))) 125 | 126 | (defn- deftype-handler [f x] 127 | (let [[_ type resolved-type args _ interfaces & fns] x] 128 | (cmp/with-lexical-scoping 129 | (doseq [arg args] 130 | (cmp/register-arg arg)) 131 | (list* 'deftype* type resolved-type args :implements interfaces 132 | (doall 133 | (map 134 | (fn [[nm args & body]] 135 | (cmp/with-lexical-scoping 136 | (doseq [arg args] 137 | (cmp/register-arg arg)) 138 | (list* nm args (doall (map f body))))) 139 | fns)))))) 140 | 141 | (defn- let-handler 142 | ([f x] 143 | (let-handler f x nil)) 144 | ([f x recursive?] 145 | (cmp/with-lexical-scoping 146 | (doall 147 | (list* 148 | (first x) 149 | (let-bindings f (second x) recursive?) 150 | (map f (drop 2 x))))))) 151 | 152 | (defn- letfn-handler [f x] 153 | (let-handler f x true)) 154 | 155 | (defn- case-handler [f [_ ge shift mask default imap switch-type check-type skip-check]] 156 | (let [prefix ['case* ge shift mask] 157 | suffix [switch-type check-type skip-check]] 158 | (concat 159 | prefix 160 | [(f default)] 161 | [(let [m (->> imap 162 | (map 163 | (fn [[k [idx form]]] 164 | [k [idx (f form)]])) 165 | (into {}))] 166 | (if (every? number? (keys m)) 167 | (into (sorted-map) m) 168 | m))] 169 | suffix))) 170 | 171 | (defn- catch-handler [f x] 172 | (let [[_ type var & body] x] 173 | (cmp/with-lexical-scoping 174 | (when var 175 | (cmp/register-arg (with-meta var (merge (meta var) {:tag type})))) 176 | (list* 'catch type var 177 | (doall (map f body)))))) 178 | 179 | (defn- try-handler [f x] 180 | (let [[_ & body] x] 181 | (list* 'try (doall (map #(f % :try-clause? true) body))))) 182 | 183 | (defn- dot-handler [f x] 184 | (let [[_ hostexpr mem-or-meth & remainder] x] 185 | (list* '. 186 | (f hostexpr) 187 | (if (seq? mem-or-meth) 188 | (list* (first mem-or-meth) 189 | (doall (map f (rest mem-or-meth)))) 190 | (f mem-or-meth)) 191 | (doall (map f remainder))))) 192 | 193 | (defn walk-exprs 194 | "A walk function which only traverses valid Clojure expressions. The `predicate` describes 195 | whether the sub-form should be transformed. If it returns true, `handler` is invoked, and 196 | returns a transformed form. 197 | 198 | Unlike `clojure.walk`, if the handler is called, the rest of the sub-form is not walked. 199 | The handler function is responsible for recursively calling `walk-exprs` on the form it is 200 | given. 201 | 202 | Macroexpansion can be halted by defining a set of `special-form?` which will be left alone. 203 | Including `fn`, `let`, or other binding forms can break local variable analysis, so use 204 | with caution. 205 | 206 | The :try-clause? option indicates that a `try` clause is being walked. The special forms 207 | `catch` and `finally` are only special in `try` clauses." 208 | ([predicate handler x] 209 | (walk-exprs predicate handler nil x)) 210 | ([predicate handler special-form? x & {:keys [try-clause?]}] 211 | (cmp/with-base-env 212 | (let [x (try 213 | (macroexpand x special-form?) 214 | (catch ClassNotFoundException _ 215 | x)) 216 | walk-exprs' (partial walk-exprs predicate handler special-form?) 217 | x' (cond 218 | 219 | (and (seq? x) (= 'var (first x)) (predicate x)) 220 | (handler (eval x)) 221 | 222 | (and (seq? x) (= 'quote (first x)) (not (predicate x))) 223 | x 224 | 225 | (predicate x) 226 | (handler x) 227 | 228 | (seq? x) 229 | (if (or (and (not try-clause?) 230 | (#{'catch 'finally} (first x))) 231 | (not (contains? special-forms (first x)))) 232 | (doall (map walk-exprs' x)) 233 | ((condp = (first x) 234 | 'do do-handler 235 | 'def def-handler 236 | 'fn* fn-handler 237 | 'let* let-handler 238 | 'loop* let-handler 239 | 'letfn* letfn-handler 240 | 'case* case-handler 241 | 'try try-handler 242 | 'catch catch-handler 243 | 'reify* reify-handler 244 | 'deftype* deftype-handler 245 | '. dot-handler 246 | #(doall (map %1 %2))) 247 | walk-exprs' (special-meta x))) 248 | 249 | (instance? java.util.Map$Entry x) 250 | (clojure.lang.MapEntry. 251 | (walk-exprs' (key x)) 252 | (walk-exprs' (val x))) 253 | 254 | (or 255 | (set? x) 256 | (vector? x)) 257 | (into (empty x) (map walk-exprs' x)) 258 | 259 | (instance? clojure.lang.IRecord x) 260 | x 261 | 262 | (map? x) 263 | (into (empty x) (map walk-exprs' x)) 264 | 265 | ;; special case to handle clojure.test 266 | (and (symbol? x) (-> x meta :test)) 267 | (vary-meta x update-in [:test] walk-exprs') 268 | 269 | :else 270 | x)] 271 | (if (instance? clojure.lang.IObj x') 272 | (with-meta x' (merge (meta x) (meta x'))) 273 | x'))))) 274 | 275 | ;;; 276 | 277 | (defn macroexpand-all 278 | "Recursively macroexpands all forms, preserving the &env special variables." 279 | [x] 280 | (walk-exprs (constantly false) nil x)) 281 | 282 | (defn special-form? 283 | "Given sym, a symbol produced by walk-exprs, returns true if sym is a special form." 284 | [x] 285 | (when (symbol? x) (::special (meta x)))) 286 | -------------------------------------------------------------------------------- /test/riddley/walk_test.clj: -------------------------------------------------------------------------------- 1 | (ns riddley.walk-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [riddley.compiler :as c] 5 | [riddley.walk :as r])) 6 | 7 | (defmacro inc-numbers [& body] 8 | (r/walk-exprs 9 | number? 10 | inc 11 | `(do ~@body))) 12 | 13 | (defmacro external-references [expr] 14 | (let [log (atom #{})] 15 | (r/walk-exprs 16 | symbol? 17 | (fn [x] 18 | (when (or (contains? &env x) 19 | (not (contains? (c/locals) x))) 20 | (swap! log conj x)) 21 | x) 22 | expr) 23 | (list 'quote @log))) 24 | 25 | (defmacro identify-special-forms [expr] 26 | (list 'quote (r/walk-exprs 27 | symbol? 28 | (comp boolean r/special-form?) 29 | expr))) 30 | 31 | (defrecord Test [x]) 32 | 33 | (defprotocol TestP 34 | (n [_])) 35 | 36 | (deftest test-walk-exprs 37 | ;; the first and third numbers get incremented, but not the second 38 | (is (= 4 (inc-numbers (case 1 2 3)))) 39 | 40 | (is (= (Test. 1) (inc-numbers #riddley.walk_test.Test{:x 1}))) 41 | 42 | (is (= 2 ((inc-numbers (fn [] 1))))) 43 | (is (= 4 (inc-numbers (+ 1 1)))) 44 | (is (= 4 (inc-numbers (let [n 1] (+ n 1))))) 45 | (is (= 42 (inc-numbers 46 | (let [n 1] 47 | (if (= n 1) 48 | 41 49 | 0))))) 50 | (is (= 2 (inc-numbers 51 | (try 52 | (/ 2 -1) () 53 | (catch Exception e 54 | 1))))) 55 | 56 | (is (= 4 (n 57 | (inc-numbers 58 | (let [n 1] 59 | (reify TestP (n [_] (+ 1 n)))))))) 60 | 61 | (is (= 4 (n 62 | (let [n 100] 63 | (eval 64 | '(riddley.walk-test/inc-numbers 65 | (deftype Foo [n] 66 | riddley.walk-test/TestP 67 | (n [_] (+ 1 n))) 68 | (Foo. 1)))))))) 69 | 70 | (deftest test-macro-shadowing 71 | (is (= :yes 72 | (inc-numbers 73 | ((fn let [x] 74 | (if (= x 0) 75 | :yes 76 | (let 0))) 77 | 2))))) 78 | 79 | (def foo 1) 80 | 81 | (deftest test-var-evaluation 82 | (is (= #{#'riddley.walk-test/foo} 83 | (let [acc (atom #{})] 84 | (r/walk-exprs 85 | (constantly true) 86 | #(do (swap! acc conj %) %) 87 | '#'riddley.walk-test/foo) 88 | @acc)))) 89 | 90 | (deftest test-doesnt-walk-var-if-not-requested 91 | (is (= #{} 92 | (let [acc (atom #{})] 93 | (r/walk-exprs 94 | (constantly false) 95 | #(do (swap! acc conj %) %) 96 | '#'riddley.walk-test/foo) 97 | @acc)))) 98 | 99 | (deftest try-catch-finally-locals 100 | (is (= '(let* [catch inc, finally dec, throw +] 101 | (try (throw (catch 100) (finally 200)) 102 | (catch Exception e) 103 | (finally nil))) 104 | 105 | (r/walk-exprs (constantly false) identity 106 | '(let [catch inc, finally dec, throw +] 107 | (try (throw (catch 100) (finally 200)) 108 | (catch Exception e) 109 | (finally nil))))))) 110 | 111 | (deftest try-catch-finally-locals-in-env 112 | (let [catch inc, finally dec, throw +] 113 | (is (= nil ((external-references 114 | (try (throw (catch 100) (finally 200)) 115 | (catch Exception e) 116 | (finally nil))) 117 | 'e))))) 118 | 119 | (deftest letfn-binds-locals-recursively 120 | (is (= nil ((external-references 121 | (letfn [(f1 [x] (inc (f2 x))) 122 | (f2 [x] (* x 100))] 123 | (f1 (f2 100)))) 124 | 'f2)))) 125 | 126 | (deftest special-forms-identified 127 | (is (= (identify-special-forms 128 | (let* [catch inc, finally dec, throw +] 129 | (try (throw (catch 100) (finally 200)) 130 | (catch Exception e) 131 | (finally nil)))) 132 | '(let* [catch false, finally false, throw false] 133 | (try (true (false 100) (false 200)) 134 | (catch Exception e) 135 | (true nil)))))) 136 | 137 | (deftest catch-old-fn*-syntax 138 | (is (= (r/walk-exprs (constantly false) identity 139 | '(fn* tst [x seq])) 140 | '(fn* tst ([x seq]))))) 141 | 142 | (deftest dot-expansion 143 | (is (= (r/macroexpand-all '(bit-and 2 1)) 144 | '(. clojure.lang.Numbers (and 2 1))))) 145 | 146 | (deftest do-not-macroexpand-quoted-things 147 | (is (= '(def p '(fn [])) 148 | (r/walk-exprs 149 | (constantly false) 150 | identity 151 | '(def p '(fn [])))))) 152 | 153 | (deftest walk-quotes-if-allowed 154 | (is (= #{'(quote (do 1 2 3))} 155 | (let [acc (atom #{})] 156 | (r/walk-exprs 157 | #(and (seq? %) (#{'quote} (first %))) 158 | #(do (swap! acc conj %) %) 159 | '(quote (do 1 2 3))) 160 | @acc)))) 161 | 162 | (deftest dont-walk-quotes-if-not-allowed 163 | (is (= #{} 164 | (let [acc (atom #{})] 165 | (r/walk-exprs 166 | #{'do} 167 | #(do (swap! acc conj %) %) 168 | '(quote (do 1 2 3))) 169 | @acc)))) 170 | 171 | (deftest handle-def-with-docstring 172 | (is (= '(def x "docstring" (. clojure.lang.Numbers (add 1 2))) 173 | (r/walk-exprs (constantly false) identity '(def x "docstring" (+ 1 2)))))) 174 | 175 | (deftest walk-over-instance-expression-in-dot-forms 176 | (is (= '(. (. clojure.lang.Numbers (add 1 2)) toString) 177 | (r/macroexpand-all '(.toString (+ 1 2)))))) 178 | 179 | 180 | (deftest meta-data-on-inline-function-macro-expasion 181 | (is (= {:foo :bar} 182 | (meta (r/macroexpand (with-meta '(+ 1 1) {:foo :bar})))))) 183 | --------------------------------------------------------------------------------