From b0533ee6a4ec0658d172e8ceda5aa576ebdffae1 Mon Sep 17 00:00:00 2001 From: Cam Saul Date: Wed, 19 Aug 2020 10:44:29 -0700 Subject: [PATCH] Code simplification and extra tests --- .dir-locals.el | 3 + project.clj | 19 ++- src/riddley/walk.clj | 297 ++++++++++++++++++++++--------------- test/riddley/walk_test.clj | 87 ++++++++--- 4 files changed, 253 insertions(+), 153 deletions(-) create mode 100644 .dir-locals.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..130b62f --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,3 @@ +((nil . ((indent-tabs-mode . nil) + (require-final-newline . t))) + (clojure-mode . ((cljr-favor-prefix-notation . nil)))) diff --git a/project.clj b/project.clj index 2d3794f..9b9b274 100644 --- a/project.clj +++ b/project.clj @@ -1,14 +1,17 @@ -(defproject riddley "0.2.0" +(defproject riddley "0.2.1-SNAPSHOT" :description "code-walking without caveats" :license {:name "MIT License" - :url "http://opensource.org/licenses/MIT"} + :url "http://opensource.org/licenses/MIT"} :dependencies [] :plugins [[lein-codox "0.9.4"]] - :codox {:src-dir-uri "https://github.com/ztellman/riddley/tree/master/" + :codox {:src-dir-uri "https://github.com/ztellman/riddley/tree/master/" :src-linenum-anchor-prefix "L" - :defaults {:doc/format :markdown} - :include [riddley.walk riddley.compiler] - :output-dir "doc"} - :profiles {:provided {:dependencies [[org.clojure/clojure "1.8.0"]]}} + :defaults {:doc/format :markdown} + :include [riddley.walk riddley.compiler] + :output-dir "doc"} + :profiles {:dev {:dependencies [[org.clojure/clojure "1.10.1"] + [pjstadig/humane-test-output "0.10.0"]] + :injections [(require 'pjstadig.humane-test-output) + (pjstadig.humane-test-output/activate!)]}} :java-source-paths ["src/riddley"] - :javac-options ["-target" "1.6" "-source" "1.6"]) + :javac-options ["-target" "1.7" "-source" "1.7"]) diff --git a/src/riddley/walk.clj b/src/riddley/walk.clj index cf35b2d..b561c3e 100644 --- a/src/riddley/walk.clj +++ b/src/riddley/walk.clj @@ -1,57 +1,101 @@ (ns riddley.walk (:refer-clojure :exclude [macroexpand]) (:require - [riddley.compiler :as cmp])) + [riddley.compiler :as cmp])) + +(declare macroexpand) + +(defn merge-meta + "If `form` can have metadata, merge other `metadatas` into its metadata. Keys in `form`'s metadata are preferred over + those in `metadatas`. + + (meta (merge-meta {} {:a 1})) ;-> {:a 1} + (meta (merge-meta nil {:a 1})) ;-> nil + (meta (merge-meta (with-meta {} {:a 2}) {:a 1, :b 1})) ;-> {:a 2, :b 1}" + [form & metadatas] + (cond-> form + (instance? clojure.lang.IObj form) (vary-meta (apply partial merge metadatas)))) + +(defn- head= + "True if `form` is list-like and the first element is `x`. + + (head= '(a b c) 'a) ;-> true" + [form x] + (and (seq? form) + (= (first form) x))) + +(defn inline-fn + "If `form` represents a call to a function that will be replaced with an inlined version by the compiler, returns the + `:inline` function used to create the replacement form; otherwise returns `nil`. + + (inline-fn '(+ 1 2)) ; -> #function[clojure.core/nary-inline/fn--5541] + (inline-fn '(+ 1 2)) ; -> nil" + [form] + (when (and (seq? form) + (not (::transformed (meta form)))) + (let [[fn-symbol & args] form] + (when (symbol? fn-symbol) + ;; a function is inlineable if it has an `:inline` function in its metadata, and, if it has an + ;; `:inline-arities` function in its metadata, returns truthy when passed the number of args in this form + (let [{:keys [inline inline-arities]} (meta (resolve fn-symbol))] + (when (and inline + (or (not inline-arities) + (inline-arities (count args)))) + inline)))))) + +(defn expand-inline-fn + "Expand an inline function call `form` into the inlined version." + ([form] + (expand-inline-fn form nil)) + + ([form special-form?] + (let [inline-fn (or (inline-fn form) + (throw (ex-info "Form is not an inlineable function call." {:form form}))) + expanded (with-meta (apply inline-fn (rest form)) (meta form))] + (macroexpand + ;; unfortunately, static function calls can look a lot like what we just + ;; expanded, so prevent infinite expansion + (if (head= expanded '.) + (with-meta + (concat (butlast expanded) [(merge-meta (last expanded) {::transformed true})]) + (meta expanded)) + expanded) + special-form?)))) + +(defn- expand-list-like + "Expand a list-like `form`." + ([form] + (expand-list-like form nil)) + + ([[head :as form] special-form?] + (if (or (and special-form? (special-form? head)) + (contains? (cmp/locals) head)) + ;; might look like a macro, but for our purposes it isn't + form + ;; otherwise attempt to macroexpand + (let [expanded (macroexpand-1 form)] + (cond + (not (identical? form expanded)) + (macroexpand expanded special-form?) + + ;; if we can't macroexpand any further, check if it's an inlined function + (inline-fn expanded) + (expand-inline-fn expanded special-form?) + + :else + form))))) (defn macroexpand - "Expands both macros and inline functions. Optionally takes a `special-form?` predicate which - identifies first elements of expressions that shouldn't be macroexpanded, and honors local - bindings." - ([x] - (macroexpand x nil)) - ([x special-form?] - (cmp/with-base-env - (if (seq? x) - (let [frst (first x)] - - (if (or - (and special-form? (special-form? frst)) - (contains? (cmp/locals) frst)) - - ;; might look like a macro, but for our purposes it isn't - x - - (let [x' (macroexpand-1 x)] - (if-not (identical? x x') - (macroexpand x' special-form?) - - ;; if we can't macroexpand any further, check if it's an inlined function - (if-let [inline-fn (and (seq? x') - (symbol? (first x')) - (-> x' meta ::transformed not) - (or - (-> x' first resolve meta :inline-arities not) - ((-> x' first resolve meta :inline-arities) - (count (rest x')))) - (-> x' first resolve meta :inline))] - (let [x'' (with-meta (apply inline-fn (rest x')) (meta x'))] - (macroexpand - ;; unfortunately, static function calls can look a lot like what we just - ;; expanded, so prevent infinite expansion - (if (= '. (first x'')) - (with-meta - (concat (butlast x'') - [(if (instance? clojure.lang.IObj (last x'')) - (with-meta (last x'') - (merge - (meta (last x'')) - {::transformed true})) - (last x''))]) - (meta x'')) - x'') - special-form?)) - x'))))) - x)))) + "Expands both macros and inline functions. Optionally takes a `special-form?` predicate which identifies first + elements of expressions that shouldn't be macroexpanded, and honors local bindings." + ([form] + (macroexpand form nil)) + + ([form special-form?] + (cmp/with-base-env + (if-not (seq? form) + form + (expand-list-like form special-form?))))) ;;; @@ -172,7 +216,7 @@ (let [[_ type var & body] x] (cmp/with-lexical-scoping (when var - (cmp/register-arg (with-meta var (merge (meta var) {:tag type})))) + (cmp/register-arg (vary-meta var assoc :tag type))) (list* 'catch type var (doall (map f body)))))) @@ -180,15 +224,23 @@ (let [[_ & body] x] (list* 'try (doall (map #(f % :try-clause? true) body))))) -(defn- dot-handler [f x] - (let [[_ hostexpr mem-or-meth & remainder] x] - (list* '. - (f hostexpr) - (if (seq? mem-or-meth) - (list* (first mem-or-meth) - (doall (map f (rest mem-or-meth)))) - (f mem-or-meth)) - (doall (map f remainder))))) +(defn- dot-handler + "Handle java interop forms." + [f [_ class-or-instance & more]] + ;; form is either of the syntax + ;; + ;; (. class-or-instance method & args) + ;; or + ;; (. class-or-instance (method & args)) + ;; + ;; both syntaxes are possible and equivalent + (if (seq? (first more)) + ;; (. class-or-instance (method & args)) + (let [[[method & args]] more] + (list '. (f class-or-instance) (cons method (doall (map f args))))) + ;; (. class-or-instance method & args) + (let [[method & args] more] + (list* '. (f class-or-instance) method (doall (map f args)))))) (defn walk-exprs "A walk function which only traverses valid Clojure expressions. The `predicate` describes @@ -206,71 +258,70 @@ The :try-clause? option indicates that a `try` clause is being walked. The special forms `catch` and `finally` are only special in `try` clauses." ([predicate handler x] - (walk-exprs predicate handler nil x)) + (walk-exprs predicate handler nil x)) + ([predicate handler special-form? x & {:keys [try-clause?]}] - (cmp/with-base-env - (let [x (try - (macroexpand x special-form?) - (catch ClassNotFoundException _ - x)) - walk-exprs' (partial walk-exprs predicate handler special-form?) - x' (cond - - (and (seq? x) (= 'var (first x)) (predicate x)) - (handler (eval x)) - - (and (seq? x) (= 'quote (first x)) (not (predicate x))) - x - - (predicate x) - (handler x) - - (seq? x) - (if (or (and (not try-clause?) - (#{'catch 'finally} (first x))) - (not (contains? special-forms (first x)))) - (doall (map walk-exprs' x)) - ((condp = (first x) - 'do do-handler - 'def def-handler - 'fn* fn-handler - 'let* let-handler - 'loop* let-handler - 'letfn* letfn-handler - 'case* case-handler - 'try try-handler - 'catch catch-handler - 'reify* reify-handler - 'deftype* deftype-handler - '. dot-handler - #(doall (map %1 %2))) - walk-exprs' (special-meta x))) - - (instance? java.util.Map$Entry x) - (clojure.lang.MapEntry. - (walk-exprs' (key x)) - (walk-exprs' (val x))) - - (or - (set? x) - (vector? x)) - (into (empty x) (map walk-exprs' x)) - - (instance? clojure.lang.IRecord x) - x - - (map? x) - (into (empty x) (map walk-exprs' x)) - - ;; special case to handle clojure.test - (and (symbol? x) (-> x meta :test)) - (vary-meta x update-in [:test] walk-exprs') - - :else - x)] - (if (instance? clojure.lang.IObj x') - (with-meta x' (merge (meta x) (meta x'))) - x'))))) + (cmp/with-base-env + (let [x (try + (macroexpand x special-form?) + (catch ClassNotFoundException _ + x)) + walk-exprs' (partial walk-exprs predicate handler special-form?) + x' (cond + + (and (head= x 'var) (predicate x)) + (handler (eval x)) + + (and (head= x 'quote) (not (predicate x))) + x + + (predicate x) + (handler x) + + (seq? x) + (if (or (and (not try-clause?) + (#{'catch 'finally} (first x))) + (not (contains? special-forms (first x)))) + (doall (map walk-exprs' x)) + ((condp = (first x) + 'do do-handler + 'def def-handler + 'fn* fn-handler + 'let* let-handler + 'loop* let-handler + 'letfn* letfn-handler + 'case* case-handler + 'try try-handler + 'catch catch-handler + 'reify* reify-handler + 'deftype* deftype-handler + '. dot-handler + #(doall (map %1 %2))) + walk-exprs' (special-meta x))) + + (instance? java.util.Map$Entry x) + (clojure.lang.MapEntry. + (walk-exprs' (key x)) + (walk-exprs' (val x))) + + (or + (set? x) + (vector? x)) + (into (empty x) (map walk-exprs' x)) + + (instance? clojure.lang.IRecord x) + x + + (map? x) + (into (empty x) (map walk-exprs' x)) + + ;; special case to handle clojure.test + (and (symbol? x) (-> x meta :test)) + (vary-meta x update-in [:test] walk-exprs') + + :else + x)] + (merge-meta x' (meta x)))))) ;;; diff --git a/test/riddley/walk_test.clj b/test/riddley/walk_test.clj index fb82d8f..6c9173c 100644 --- a/test/riddley/walk_test.clj +++ b/test/riddley/walk_test.clj @@ -6,9 +6,9 @@ (defmacro inc-numbers [& body] (r/walk-exprs - number? - inc - `(do ~@body))) + number? + inc + `(do ~@body))) (defmacro external-references [expr] (let [log (atom #{})] @@ -33,6 +33,50 @@ (defprotocol TestP (n [_])) +(deftest merge-meta-test + (is (= {:a 1} + (meta (r/merge-meta {} {:a 1})))) + (is (= nil + (meta (r/merge-meta nil {:a 1} {:c 1})))) + (is (= {:a 2, :b 1, :c 1} + (meta (r/merge-meta (with-meta {} {:a 2}) {:a 1, :b 1} {:c 1}))))) + +(deftest inline-fn-test + (doseq [[form expected] {'(+ 1) nil + `(+ 1) nil + '(+ 1 2) true + `(+ 1 2) true + '(int 1) true + `(int 1) true + `(n 1) nil + `+ nil + `n nil} + ;; any form with `::transformed` in its metadata should always come back as nil + [form expected] [[form expected] + [(with-meta form {:riddley.walk/transformed true}) nil]]] + (testing (binding [*print-meta* true] (pr-str (list 'inline-fn? form))) + (if expected + (is (fn? (r/inline-fn form))) + (is (= expected + (r/inline-fn form))))))) + +(deftest head=-test + (is (= true + (#'r/head= '(a b c) 'a))) + (is (= false + (#'r/head= '(a b c) 'b))) + (is (= false + (#'r/head= 1 'a)))) + +(deftest expand-inline-fn-test + (is (= '(. clojure.lang.Numbers (and 2 1)) + (r/expand-inline-fn '(bit-and 2 1) nil))) + (testing "Should throw an Exception if the form is not inlineable" + (is (thrown-with-msg? + clojure.lang.ExceptionInfo + #"Form is not an inlineable function call" + (r/expand-inline-fn '(+ 1) nil))))) + (deftest test-walk-exprs ;; the first and third numbers get incremented, but not the second (is (= 4 (inc-numbers (case 1 2 3)))) @@ -43,29 +87,29 @@ (is (= 4 (inc-numbers (+ 1 1)))) (is (= 4 (inc-numbers (let [n 1] (+ n 1))))) (is (= 42 (inc-numbers - (let [n 1] - (if (= n 1) - 41 - 0))))) + (let [n 1] + (if (= n 1) + 41 + 0))))) (is (= 2 (inc-numbers - (try - (/ 2 -1) () - (catch Exception e - 1))))) + (try + (/ 2 -1) () + (catch Exception e + 1))))) (is (= 4 (n - (inc-numbers - (let [n 1] - (reify TestP (n [_] (+ 1 n)))))))) + (inc-numbers + (let [n 1] + (reify TestP (n [_] (+ 1 n)))))))) (is (= 4 (n - (let [n 100] - (eval - '(riddley.walk-test/inc-numbers - (deftype Foo [n] - riddley.walk-test/TestP - (n [_] (+ 1 n))) - (Foo. 1)))))))) + (let [n 100] + (eval + '(riddley.walk-test/inc-numbers + (deftype Foo [n] + riddley.walk-test/TestP + (n [_] (+ 1 n))) + (Foo. 1)))))))) (deftest test-macro-shadowing (is (= :yes @@ -176,7 +220,6 @@ (is (= '(. (. clojure.lang.Numbers (add 1 2)) toString) (r/macroexpand-all '(.toString (+ 1 2)))))) - (deftest meta-data-on-inline-function-macro-expasion (is (= {:foo :bar} (meta (r/macroexpand (with-meta '(+ 1 1) {:foo :bar}))))))