├── .circleci └── config.yml ├── .gitignore ├── .lsp └── config.edn ├── CHANGELOG.md ├── LICENSE ├── README.md ├── find-used-locals-trin-poc ├── .gitignore ├── README.md ├── deps.edn ├── project.clj ├── src │ └── thomasa │ │ └── find_used_locals_trin_poc.clj └── test │ └── thomasa │ └── find_used_locals_trin_poc_test.clj └── trin ├── README.md ├── deps.edn ├── dev └── user.clj ├── project.clj ├── src └── thomasa │ └── trin.clj └── test └── thomasa └── trin_test.clj /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2.1 2 | orbs: 3 | codecov: codecov/codecov@1.0.4 4 | jobs: 5 | build: 6 | docker: 7 | - image: circleci/clojure:tools-deps 8 | 9 | working_directory: ~/trin-mono/trin 10 | 11 | environment: 12 | CODECOV_TOKEN: "5a28bd3c-5e48-4855-b746-7ebc7caf78b6" 13 | 14 | steps: 15 | - checkout: 16 | path: ~/trin-mono 17 | - restore_cache: 18 | keys: 19 | - v1-dependencies-{{ checksum "deps.edn" }} 20 | # fallback to using the latest cache if no exact match is found 21 | - v1-dependencies- 22 | - run: pwd 23 | - run: ls -la 24 | - run: clojure -A:test -Spath 25 | - save_cache: 26 | paths: 27 | - ~/.m2 28 | key: v1-dependencies-{{ checksum "deps.edn" }} 29 | - run: clojure -A:test -m kaocha.runner 30 | - run: clojure -A:test -m kaocha.runner --plugin cloverage --codecov 31 | - codecov/upload: 32 | file: target/coverage/codecov.json 33 | - run: 34 | command: | 35 | cd ../find-used-locals-trin-poc/ 36 | clojure -A:test -m kaocha.runner 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.cpcache 9 | /.lein-* 10 | /.nrepl-history 11 | .nrepl-port 12 | .hgignore 13 | .hg/ 14 | *~ 15 | .cpcache 16 | target/ 17 | sqlite.1.db 18 | *.lein* -------------------------------------------------------------------------------- /.lsp/config.edn: -------------------------------------------------------------------------------- 1 | {"dependency-scheme" "jar"} 2 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## [Unreleased] 4 | 5 | ### Changed 6 | - PoC for to explore reimplementing `refactor-nrepl.find.find-locals` using `trin` 7 | - analyse locals: support fn arguments, let-like constructs 8 | - analyse a string containing one form or multiple first level forms (a namespace) 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright © 2019 Benedek Fazekas 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![CircleCI](https://circleci.com/gh/benedekfazekas/trin/tree/master.svg?style=svg)](https://circleci.com/gh/benedekfazekas/trin/tree/master) 2 | 3 | # trin 4 | 5 | - [`trin`](trin/) a static analyzer for Clojure, ClojureScript (and eventually ClojureC) 6 | - [PoC](find-used-locals-trin-poc/) to explore reimplementing `refactor-nrepl.find.find-locals` using `trin` 7 | 8 | ## Status 9 | 10 | `trin` is **alpha**. 11 | 12 | Currently `trin` only focuses on analysing locals to achieve a PoC for `find-locals`. 13 | 14 | That said this should unlock the following features (based on [refactor-nrepl](https://github.com/clojure-emacs/clj-refactor.el)): 15 | 16 | - promote fn 17 | - extract function 18 | - inline local symbol 19 | - find local usages/rename local symbol 20 | - create-fn from example 21 | 22 | without the need of a REPL. 23 | 24 | ## License 25 | 26 | Copyright © 2019 Benedek Fazekas 27 | -------------------------------------------------------------------------------- /find-used-locals-trin-poc/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.cpcache 9 | /.lein-* 10 | /.nrepl-history 11 | /.nrepl-port 12 | .hgignore 13 | .hg/ 14 | -------------------------------------------------------------------------------- /find-used-locals-trin-poc/README.md: -------------------------------------------------------------------------------- 1 | # find-used-locals `trin` PoC 2 | 3 | PoC to explore reimplementing https://github.com/clojure-emacs/refactor-nrepl/blob/bc22338e9d92c33147a138fa8f83fb22d26d51f0/src/refactor_nrepl/find/find_locals.clj with `trin`. 4 | 5 | To achieve this `find-locals` was reimplemented in [`thomasa.find-used-locals-trin-poc/find-used-locals`](src/thomasa/find_used_locals_trin_poc.clj) using `trin` to retrieve an AST for the selected SEXPR. The machinery to find the selected SEXPR was also brought over from `refactor-nrepl` and adapted to work with `trin` AST. 6 | 7 | The tests were also brought over from `refactor-nrepl` to test this particular function to validate the PoC. `trin` does a bit more than necessary to make these tests pass, those extra features are unit tested in the `trin` project itself. 8 | 9 | Find locals was picked because while discussing our problems with `refactor-nrepl` (the lack of cljs/cljc support) due to the analyzer we use we figured that this feature was a good candidate to experiment with new analyzers. 10 | 11 | See [refactor-nrepl#195](https://github.com/clojure-emacs/refactor-nrepl/issues/195) for more context. And [this commit](https://github.com/clojure-emacs/refactor-nrepl/commit/8b651a0e23b62a390f343f891e8ef6bb6e8cd32f) for a PoC using `cljs.analyzer` for cljs. 12 | 13 | ## Running the tests 14 | 15 | ``` 16 | clojure -A:test -m kaocha.runner 17 | ``` 18 | -------------------------------------------------------------------------------- /find-used-locals-trin-poc/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["resources" "src"] 2 | :deps {org.clojure/clojure {:mvn/version "RELEASE"} 3 | thomasa/trin {:local/root "../trin/"}} 4 | :aliases 5 | {:test {:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-418"}}}}} 6 | -------------------------------------------------------------------------------- /find-used-locals-trin-poc/project.clj: -------------------------------------------------------------------------------- 1 | (require '[clojure.edn :as edn]) 2 | 3 | (def +deps+ (-> "deps.edn" slurp edn/read-string)) 4 | 5 | (defn deps->vec [deps] 6 | (->> deps 7 | (filter (fn [[_ params]] (:mvn/version params))) 8 | (mapv (fn [[dep {:keys [:mvn/version exclusions]}]] 9 | (cond-> [dep version] 10 | exclusions (conj :exclusions exclusions)))))) 11 | 12 | (def dependencies 13 | (deps->vec (:deps +deps+))) 14 | 15 | (defproject thomasa/find-used-locals-trin-poc "0.1.0-SNAPSHOT" 16 | :source-paths ["src" "../trin/src"] 17 | :dependencies ~dependencies) 18 | -------------------------------------------------------------------------------- /find-used-locals-trin-poc/src/thomasa/find_used_locals_trin_poc.clj: -------------------------------------------------------------------------------- 1 | (ns thomasa.find-used-locals-trin-poc 2 | (:require [rewrite-clj.zip :as zip] 3 | [rewrite-clj.zip.subedit :as zip-subedit] 4 | [thomasa.trin :as trin] 5 | [clojure.set :as set])) 6 | 7 | (defn foo 8 | "I don't do a whole lot." 9 | [x] 10 | (println x "Hello, World!") 11 | (trin/analyze-loc {} (zip/of-string "[1 2 3]")) 12 | :foo) 13 | 14 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15 | ;; borrowed from refactor-nrepl for now 16 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17 | 18 | (defn all-zlocs 19 | "Generate a seq of all zlocs in a depth-first manner" 20 | [zipper] 21 | (take-while (complement zip/end?) (iterate zip/next zipper))) 22 | 23 | (defn- node-at-loc? 24 | "True if node encloses point defined by `loc-line` and `loc-column`." 25 | [zloc ^long loc-line ^long loc-column] 26 | (let [[line end-line column end-column] (->> (zip/node zloc) 27 | meta 28 | ((juxt :row :end-row :col :end-col)) 29 | (map (comp dec long)))] 30 | (or (< line loc-line end-line) 31 | (and (or (= line loc-line) 32 | (= end-line loc-line)) 33 | (<= column loc-column end-column))))) 34 | 35 | (defn- zip-to 36 | "Move the zipper to the node at `loc-line` and `loc-col`. 37 | 38 | Implementation uses `all-zlocs` and exploits the fact that it generates 39 | a seq of nodes in depth-first order." 40 | [zipper ^long loc-line ^long loc-column] 41 | (reduce 42 | (fn [node-at-loc zloc] 43 | (if (node-at-loc? zloc loc-line loc-column) zloc node-at-loc)) 44 | zipper 45 | (all-zlocs zipper))) 46 | 47 | (defn get-enclosing-sexp 48 | "Extracts the sexp enclosing point at LINE and COLUMN in FILE-CONTENT, 49 | and optionally LEVEL. 50 | 51 | A string is not treated as a sexp by this function. If LEVEL is 52 | provided finds the enclosing sexp up to level. LEVEL defaults to 1 53 | for the immediate enclosing sexp. 54 | 55 | Both line and column are indexed from 0." 56 | ([parsed-content line column] 57 | (get-enclosing-sexp parsed-content line column 1)) 58 | ([parsed-content ^long line ^long column ^long level] 59 | (let [zloc (zip-to parsed-content line column) 60 | zloc (nth (iterate zip/up zloc) (dec level))] 61 | (zip-subedit/subzip 62 | (cond 63 | (and zloc (string? (zip/sexpr zloc))) (zip/up zloc) 64 | (and zloc (seq? (zip/sexpr zloc))) zloc 65 | zloc (zip/up zloc) 66 | :else (throw (ex-info "Can't find sexp boundary" 67 | {:file-content (zip/sexpr parsed-content) 68 | :line line 69 | :column column}))))))) 70 | 71 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 72 | ;; borrowed from refactor-nrepl ends 73 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 74 | 75 | 76 | (defn find-used-locals 77 | "Adapted version of refactor-nrepl's `refactor-nrepl.find.find-locals/find-used-locals`." 78 | [source ^long line ^long column] 79 | (let [selected-sexp (-> (trin/analyze-loc-string {} source) 80 | (get-enclosing-sexp line column)) 81 | locals-in-use (->> (all-zlocs selected-sexp) 82 | (filter #(= :local (get-in % [0 :ast-info :op]))) 83 | (map zip/sexpr) 84 | set) 85 | available-locals (-> selected-sexp first :ast-info :env :locals keys set)] 86 | (println "selected sexp" (zip/sexpr selected-sexp) 87 | " locals in use" locals-in-use 88 | " avail locals: " available-locals) 89 | (set/intersection available-locals locals-in-use))) 90 | -------------------------------------------------------------------------------- /find-used-locals-trin-poc/test/thomasa/find_used_locals_trin_poc_test.clj: -------------------------------------------------------------------------------- 1 | (ns thomasa.find-used-locals-trin-poc-test 2 | (:require [clojure.test :as t] 3 | [thomasa.find-used-locals-trin-poc :as sut])) 4 | 5 | (t/deftest a-test 6 | (t/testing "I pass" 7 | (t/is (= 1 1))) 8 | (t/testing "depending on local trin" 9 | (t/is (= :foo (sut/foo :ignore))))) 10 | 11 | (def no-args-defn-with-let 12 | "(defn not-doing-much [] 13 | (map name [:a :b :c]) 14 | (let [prefix \"prefix-\" 15 | postfix \"-postfix\"] 16 | (->> (map name [:a :b :c]) 17 | (map #(str prefix %)))))") 18 | 19 | (def example-five 20 | "(ns com.example.five 21 | (:require [clojure.string :refer [join split blank? trim] :as str])) 22 | 23 | ;; remove parameters to run the tests 24 | (defn fn-with-unbounds [s sep] 25 | (when-not (blank? s) 26 | (-> s (split #\" \") 27 | (join sep) 28 | trim))) 29 | 30 | (defn orig-fn [s] 31 | (let [sep \";\"] 32 | (when-not (blank? s) 33 | (-> s 34 | (split #\" \") 35 | ((partial join sep)) 36 | trim)))) 37 | 38 | (defn find-in-let [s p] 39 | (let [z (trim p)] 40 | (assoc {:s s 41 | :p p 42 | :z z} :k \"foobar\"))) 43 | 44 | (defn threading-macro [strings] 45 | (let [sep \",\"] 46 | (->> strings 47 | flatten 48 | (join sep)))) 49 | 50 | (defn repeated-sexp [] 51 | (map name [:a :b :c]) 52 | (let [name #(str \"myname\" %)] 53 | (map name [:a :b :c]))) 54 | 55 | (defn sexp-with-anon-fn [n] 56 | (let [g 5] 57 | (#(+ g %) n))) 58 | 59 | (defn many-params [x y z a b c] 60 | (* x y z a b c)) 61 | 62 | (defn fn-with-default-optmap 63 | [{:keys [foo bar] :or {foo \"foo\"}}] 64 | [:bar :foo] 65 | (count foo)) 66 | 67 | (defn fn-with-default-optmap-linebreak 68 | [{:keys [foo 69 | bar] 70 | :or {foo 71 | \"foo\"}}] 72 | [:bar :foo] 73 | (count foo)) 74 | 75 | (defn fn-with-let-default-optmap [] 76 | (let [{:keys [foo bar] :or {foo \"foo\"}} (hash-map)] 77 | [:bar :foo] 78 | (count foo))) 79 | ") 80 | 81 | (t/deftest test-simple-let 82 | (t/is (= #{} (sut/find-used-locals no-args-defn-with-let 1 10)) 83 | "Used locals empty outside let.") 84 | (t/is (= #{} (sut/find-used-locals no-args-defn-with-let 3 12)) 85 | "Used locals empty in bindings form of let") 86 | (t/is (= '#{prefix} (sut/find-used-locals no-args-defn-with-let 5 21)) 87 | "Used local should be symbol 'prefix and only 'prefix")) 88 | 89 | (t/deftest test-find-used-locals 90 | (t/testing "testing find used locals in simple args and let cases" 91 | (t/is (= '#{s} 92 | (sut/find-used-locals example-five 11 6))) 93 | (t/is (= '#{sep s} 94 | (sut/find-used-locals example-five 12 13))) 95 | (t/is (= '#{p} 96 | (sut/find-used-locals example-five 19 16))) 97 | (t/is (= '#{sep strings} 98 | (sut/find-used-locals example-five 26 8))) 99 | (t/is (= '#{name} 100 | (sut/find-used-locals example-five 33 8))) 101 | (t/is (= '#{n} 102 | (sut/find-used-locals example-five 36 5))) 103 | (t/is (= '#{x y z a b c} 104 | (sut/find-used-locals example-five 40 4))))) 105 | 106 | (t/deftest test-find-used-locals-with-destructuring 107 | (t/testing "testing destrucuring in args" 108 | (t/is (= #{} 109 | (sut/find-used-locals example-five 44 7))) 110 | (t/is (= '#{foo} 111 | (sut/find-used-locals example-five 45 7)))) 112 | (t/testing "testing desctructuring in let" 113 | (t/is (= #{} 114 | (sut/find-used-locals example-five 57 7))) 115 | (t/is (= '#{foo} 116 | (sut/find-used-locals example-five 58 7))))) 117 | -------------------------------------------------------------------------------- /trin/README.md: -------------------------------------------------------------------------------- 1 | [![codecov](https://codecov.io/gh/benedekfazekas/trin/branch/master/graph/badge.svg)](https://codecov.io/gh/benedekfazekas/trin) 2 | 3 | # trin 4 | 5 | A tiny analyzer, maybe. 6 | 7 | `trin` is a static, non-evaling [rewrite-clj](https://github.com/xsc/rewrite-clj) based analyzer. It decorates [rewrite-clj](https://github.com/xsc/rewrite-clj) nodes with the information gathered in the analysis turning them into AST nodes. The AST information added complies with [tools.analyzer(.jvm) AST](http://clojure.github.io/tools.analyzer.jvm/spec/quickref.html) where it makes sense, altough the above spec is extended at places. The usual [rewrite-clj](https://github.com/xsc/rewrite-clj) tools can be used to traverse the tree after analysis. 8 | 9 | Macros are not expanded as of now. `trin` very likely will focus on analysing the non macroexpanded source in the future too. However, it may analyse macroexpanded source in the future **additionally** and/or add an extension point to handle custom macros. 10 | 11 | Compared to other [rewrite-clj](https://github.com/xsc/rewrite-clj) based analysis tools like [clj-kondo](https://github.com/borkdude/clj-kondo) and [clojure-lsp](https://github.com/snoe/clojure-lsp) `trin` aims to create a generic AST for other tools to work with. 12 | 13 | As [rewrite-clj](https://github.com/xsc/rewrite-clj) handles both Clojure and ClojureScript well `trin` supports both. There is a bit more machinery needed to support cljc files, this will be added eventually too. 14 | 15 | ## Usage 16 | 17 | ```clojure 18 | (require '[rewrite-clj.zip :as zip]) 19 | (require '[thomasa.trin :as trin]) 20 | 21 | (def source-as-string "(defn foo [f] f)") 22 | 23 | (trin/analyze-loc {} (zip/of-string source-as-string) 24 | ``` 25 | 26 | Find the AST information in the returned `rewrite-clj` nodes under `[0 :ast-info]`. See a small utility function to print AST info for nodes in the [user namespace](dev/user.clj). 27 | 28 | ### Running the tests 29 | 30 | ``` 31 | clojure -A:test -m kaocha.runner 32 | ``` 33 | 34 | ## Credits 35 | 36 | Thanks for all authors/maintainers/contributors of projects mentioned above. 37 | -------------------------------------------------------------------------------- /trin/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["resources" "src"] 2 | :deps {org.clojure/clojure {:mvn/version "RELEASE"} 3 | rewrite-clj {:mvn/version "0.6.1"}} 4 | :aliases 5 | {:test {:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-418"} 6 | lambdaisland/kaocha-cloverage {:mvn/version "0.0-32"}}}}} 7 | -------------------------------------------------------------------------------- /trin/dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require [thomasa.trin :as trin] 3 | [rewrite-clj.zip :as zip])) 4 | 5 | (defn print-ast-info [ast] 6 | (doseq [node (trin/all-zlocs ast)] 7 | (println "sexpr:" (zip/sexpr node) "\n ast:" (pr-str (:ast-info (first node)))) 8 | (println))) 9 | -------------------------------------------------------------------------------- /trin/project.clj: -------------------------------------------------------------------------------- 1 | (require '[clojure.edn :as edn]) 2 | 3 | (def +deps+ (-> "deps.edn" slurp edn/read-string)) 4 | 5 | (defn deps->vec [deps] 6 | (mapv (fn [[dep {:keys [:mvn/version exclusions]}]] 7 | (cond-> [dep version] 8 | exclusions (conj :exclusions exclusions))) 9 | deps)) 10 | 11 | (def dependencies 12 | (deps->vec (:deps +deps+))) 13 | 14 | (defproject thomasa/trin "0.1.0-SNAPSHOT" 15 | :dependencies ~dependencies) 16 | -------------------------------------------------------------------------------- /trin/src/thomasa/trin.clj: -------------------------------------------------------------------------------- 1 | (ns thomasa.trin 2 | (:require [rewrite-clj.zip :as zip] 3 | [rewrite-clj.zip.subedit :as zsub] 4 | [clojure.zip :as clj-zip])) 5 | 6 | ;; zip utils 7 | (defn all-zlocs 8 | "Generate a seq of all zlocs in a depth-first manner" 9 | [zipper] 10 | (take-while (complement zip/end?) (iterate zip/next zipper))) 11 | 12 | (defn- skip-to-bottom 13 | "Skips to the bottom to the given loc in terms of setting the zipper to the 14 | deepest rightmost node." 15 | [loc] 16 | (or (some-> (zip/down loc) 17 | zip/rightmost 18 | skip-to-bottom) 19 | (zip/rightmost loc))) 20 | 21 | (defn- skip-over 22 | "Skips over loc to the beginning of the next loc if available." 23 | [loc] 24 | (zip/next (skip-to-bottom loc))) 25 | 26 | ;; predicates 27 | (defn- let-like-loc? 28 | "Is `node` a let sexpr?" 29 | [node] 30 | (and (zip/seq? node) 31 | (#{'let 'loop 'loop* 'if-let 'when-let 'letfn 'for :let} (zip/sexpr (zip/down node))))) 32 | 33 | (defn- fn-loc? 34 | "Is `node` an fn sexpr?" 35 | [node] 36 | (and (zip/seq? node) 37 | (#{'defn 'defn- 'fn 'fn*} (zip/sexpr (zip/down node))))) 38 | 39 | (defn- locals-contains? 40 | "Does `locs` contain node's sexpr?" 41 | [locs node] 42 | ((set (keys locs)) (zip/sexpr node))) 43 | 44 | ;; ast info manipulation 45 | (def analyzed->local 46 | {'let :let 47 | :let :let 48 | 'let* :let 49 | 'when-let :let 50 | 'if-let :let 51 | 'letfn :let 52 | 'for :for 53 | 'loop :loop 54 | 'loop* :loop 55 | 'defn :arg 56 | 'defn- :arg 57 | 'fn :arg 58 | 'fn* :arg}) 59 | 60 | (defn- attach-ast-info 61 | "Attach info to the node under the key `:ast-info` and the suppliend `ast-key`. 62 | `ast-fn-value` should accept the original value under `[:ast-info ast-key]`." 63 | [loc ast-key ast-value-fn] 64 | (clj-zip/edit loc (fn [m] (update-in m [:ast-info ast-key] ast-value-fn)))) 65 | 66 | (defn- add-to-locals 67 | "Assocs `local-info` under the sexpr of `binding-node` as key into 68 | the locals atom. The shape of data stored under the key therefore depends on 69 | the type of local." 70 | [bound-sym-node local-info locals] 71 | (swap! locals assoc (zip/sexpr bound-sym-node) local-info)) 72 | 73 | (defn- resolve-init 74 | "Tries to resolve `init-k` recusively in terms of resolving the resolved value 75 | as key." 76 | [locs init-k] 77 | (when-let [init-v (and locs (:init (locs init-k)))] 78 | (or (resolve-init locs init-v) 79 | init-v))) 80 | 81 | (defn- decorate-local-node [node locs] 82 | (reduce 83 | (fn [node [loc-k loc-v]] 84 | (attach-ast-info node loc-k (constantly loc-v))) 85 | node 86 | (locs (zip/sexpr node)))) 87 | 88 | ;; analyze handlers 89 | (declare analyze-form) 90 | (declare analyze-vector-of-locals) 91 | 92 | (defn- analyze-defaults-map 93 | "Analyzes a defaults map for desctructuring." 94 | [locals defaults-key] 95 | (let [defaults-value (zip/right defaults-key)] 96 | (swap! locals 97 | assoc-in 98 | [(zip/sexpr defaults-key) :default-value] 99 | (zip/sexpr defaults-value)) 100 | (when-let [next-defaults-key (zip/right defaults-value)] 101 | (analyze-defaults-map locals next-defaults-key)))) 102 | 103 | (defn- analyze-map-desctructuring* [locals env k local-info] 104 | (let [v (zip/right k) 105 | key-sexpr (zip/sexpr k)] 106 | (cond 107 | 108 | (and (map? key-sexpr) (zip/down k)) 109 | (analyze-map-desctructuring* locals env (zip/down k) local-info) 110 | 111 | (#{:keys :strs :syms} key-sexpr) 112 | (analyze-vector-of-locals locals (dissoc env :analyzing) (zip/down v) local-info) 113 | 114 | (#{:or} key-sexpr) 115 | (analyze-defaults-map locals (zip/down v)) 116 | 117 | (#{:as} key-sexpr) 118 | (add-to-locals 119 | v 120 | (-> (assoc local-info :op :local) 121 | (assoc :as? true)) 122 | locals) 123 | 124 | :default 125 | (add-to-locals 126 | k 127 | (assoc local-info :op :local) 128 | locals)) 129 | (if-let [next-k (zip/right v)] 130 | (analyze-map-desctructuring* locals env next-k local-info) 131 | v))) 132 | 133 | (defn- analyze-map-desctructuring 134 | "Analyzes destructuring of maps." 135 | [locals env arg local-info] 136 | (if-let [first-key (zip/down arg)] 137 | (zip/up (analyze-map-desctructuring* locals env first-key local-info)) 138 | arg)) 139 | 140 | (defn- analyze-destructuring 141 | "Analyzes destructuring." 142 | [locals env arg arg-sexpr local-info] 143 | (cond 144 | (vector? arg-sexpr) 145 | (when-let [first-arg (zip/down arg)] 146 | (analyze-vector-of-locals locals env first-arg local-info)) 147 | 148 | (map? arg-sexpr) 149 | (analyze-map-desctructuring locals env arg local-info))) 150 | 151 | (defn- analyze-bindings* 152 | [locals env node] 153 | (let [binding node 154 | binding-sexpr (zip/sexpr node) 155 | init (->> (merge env {:locals @locals}) 156 | (partial analyze-form) 157 | (zsub/subedit-node (zip/right binding))) 158 | init-sexpr (zip/sexpr init) 159 | local-info {:op :local 160 | :local (analyzed->local (:analyzing env) :undefined) 161 | :init init-sexpr 162 | :init-resolved (resolve-init @locals init-sexpr)}] 163 | (cond 164 | (= :let binding-sexpr) 165 | (analyze-bindings* locals env (zip/down (zip/right node))) 166 | 167 | (symbol? binding-sexpr) 168 | (add-to-locals binding local-info locals) 169 | 170 | :default 171 | (analyze-destructuring locals env binding binding-sexpr local-info)) 172 | (if-let [next-binding (zip/right init)] 173 | (analyze-bindings* locals env next-binding) 174 | init))) 175 | 176 | (defn- analyze-bindings 177 | "Analyzes a binding form eg. `[a (some sexpr) b (some other sexpr)]`. 178 | Calls `add-to-locals` to modify value of `locals` atom to record locals 179 | defined in binding. Init sexps are analyzed by calling `analyze-form`." 180 | [locals env node] 181 | (if-let [first-binding (zip/down node)] 182 | (zip/up (analyze-bindings* locals env first-binding)) 183 | node)) 184 | 185 | (defn- analyze-sexprs-in-do* 186 | [env node] 187 | (let [node (zsub/subedit-node node (partial analyze-form env))] 188 | (if-let [next-body-loc (zip/right node)] 189 | (analyze-sexprs-in-do* env next-body-loc) 190 | node))) 191 | 192 | (defn- analyze-sexprs-in-do 193 | "Analyzes an (implicit) do body by calling `analyze-form` on every sexpr in the body 194 | sequentially. 195 | 196 | Expect node to point to the sexpr to the left of the do. That would be the binding 197 | vector for a `let`." 198 | [locals env node] 199 | (if-let [first-body-loc (zip/right node)] 200 | (analyze-sexprs-in-do* (merge env {:locals @locals}) first-body-loc) 201 | node)) 202 | 203 | (defn- analyze-let-loc 204 | "Analyzes a let expression." 205 | [env loc-let] 206 | (let [locals (atom (:locals env))] 207 | (-> (zip/down loc-let) 208 | zip/right 209 | (zsub/subedit-node (partial analyze-bindings locals env)) 210 | ((partial analyze-sexprs-in-do locals env)) 211 | zip/up))) 212 | 213 | (defn- ->rest-seq-key [env] 214 | (or (and (= :arg (analyzed->local (:analyzing env) :undefined)) 215 | :variadic?) 216 | :rest-seq?)) 217 | 218 | (defn- analyze-vector-of-locals 219 | "Analyzes a vector of locals either in arguments or in desctructuring." 220 | [locals env arg local-info] 221 | (let [arg-sexpr (zip/sexpr arg) 222 | arg (or (and (= '& arg-sexpr) (zip/right arg)) arg)] 223 | (cond 224 | (= '& arg-sexpr) 225 | (add-to-locals 226 | arg 227 | (-> (assoc local-info :op :local) 228 | (assoc (->rest-seq-key env) true)) 229 | locals) 230 | 231 | (symbol? arg-sexpr) 232 | (add-to-locals 233 | arg 234 | (assoc local-info :op :local) 235 | locals) 236 | 237 | :default 238 | (analyze-destructuring locals env arg arg-sexpr local-info)) 239 | (if-let [next-arg (zip/right arg)] 240 | (analyze-vector-of-locals 241 | locals 242 | env 243 | next-arg 244 | (or (and (:arg-id local-info) 245 | (= :arg (analyzed->local (:analyzing env) :undefined)) 246 | (update local-info :arg-id inc)) 247 | local-info)) 248 | arg))) 249 | 250 | (defn- analyze-args 251 | "Analyzes arguments vector of an fn form." 252 | [locals env args-loc] 253 | (if-let [first-arg (zip/down args-loc)] 254 | (zip/up 255 | (analyze-vector-of-locals 256 | locals 257 | env 258 | first-arg 259 | {:local (analyzed->local (:analyzing env) :undefined) 260 | :arg-id 0})) 261 | args-loc)) 262 | 263 | (defn- analyze-fn-loc 264 | "Analyzes an fn loc." 265 | [env loc-fn] 266 | (let [locals (atom (:locals env))] 267 | (-> (zip/down loc-fn) 268 | (zip/find (fn [node] (= :vector (zip/tag node)))) 269 | (zsub/subedit-node (partial analyze-args locals env)) 270 | ((partial analyze-sexprs-in-do locals env)) 271 | zip/up))) 272 | 273 | (defn- prepare-env [node env] 274 | (assoc env :analyzing (or (fn-loc? node) (let-like-loc? node)))) 275 | 276 | (defn- analyze-node 277 | "Analyzes a node with `env`." 278 | [env node] 279 | (let [locs (:locals env) 280 | env (prepare-env node env)] 281 | (cond-> node 282 | 283 | (locals-contains? locs node) 284 | (decorate-local-node locs) 285 | 286 | :always 287 | (attach-ast-info :env (fn [env] (assoc env :locals locs))) ;; or update with merge?! 288 | 289 | (fn-loc? node) 290 | (-> (zsub/subedit-node (partial analyze-fn-loc env)) 291 | skip-to-bottom) 292 | 293 | (let-like-loc? node) 294 | (-> (zsub/subedit-node (partial analyze-let-loc env)) 295 | skip-to-bottom)))) 296 | 297 | (defn analyze-form 298 | "Analyzes `loc` representing a first level form by walking it and calling `analyze-node` on every node." 299 | [env loc] 300 | (zip/prewalk 301 | loc 302 | (partial analyze-node env))) 303 | 304 | (defn analyze-loc 305 | "Analyzes all first level forms in `loc`. 306 | 307 | `loc` typically represents a namespace." 308 | [env loc] 309 | (loop [loc loc] 310 | (let [loc (analyze-form env loc) 311 | next-loc (skip-over loc)] 312 | (if-not (zip/end? next-loc) 313 | (recur next-loc) 314 | (zip/leftmost loc))))) 315 | 316 | (defn analyze-loc-string 317 | "Analyzes all first level forms in `loc-str` 318 | 319 | `loc-str` typically represents a namespace and of type string." 320 | [env loc-str] 321 | (analyze-loc env (zip/of-string loc-str))) 322 | 323 | ;; -- empty things: empty let bindings, empty let body 324 | -------------------------------------------------------------------------------- /trin/test/thomasa/trin_test.clj: -------------------------------------------------------------------------------- 1 | (ns thomasa.trin-test 2 | (:require [clojure.test :as t] 3 | [rewrite-clj.zip :as zip] 4 | [thomasa.trin :as trin])) 5 | 6 | (def embedded-let 7 | "(do 8 | (println \"foobar\" ) 9 | (let [a 1 10 | b a 11 | c 3] 12 | (println a) 13 | [b c]) 14 | (println \"baz\"))") 15 | 16 | (def let-in-let 17 | "(do 18 | (println \"foobar\" ) 19 | (let [a 1 20 | b a 21 | c 3] 22 | (println a) 23 | (let [c (inc c)] 24 | [b c])) 25 | (println \"baz\"))") 26 | 27 | (def defn-with-arg 28 | "(defn not-much-on-kw [kw] 29 | (println \"kw:\" (name kw)))") 30 | 31 | (def defn-with-varargs 32 | "(defn not-much-on-kws [kw & other-kws] 33 | (println \"kw:\" (name kw) \"others: \" (map name other-kws)))") 34 | 35 | (def defn-with-map-destruct-as-defaults-varargs 36 | "(defn fn-with-default-optmap-linebreak 37 | [{:keys [foo 38 | bar] 39 | :as all-the-things 40 | :or {foo 41 | \"foo\"}} 42 | & rest-args] 43 | [:bar :foo] 44 | (count foo))") 45 | 46 | (def defn-nested-and-combined-destructurings 47 | "(defn plain-destruct [an-arg {{:keys [bar] :as inner} :foo :as outer} & rest-args] 48 | (println \"bar\" bar \"outer\" outer :inner inner))") 49 | 50 | (def defn-using-loop 51 | "(defn fn-using-loop [] 52 | (loop [[kw & rest-kws] [:a :b :c :d]] 53 | (when kw 54 | (println kw) 55 | (recur rest-kws))))") 56 | 57 | (def defn-with-for 58 | "(defn simple-for-fn [] 59 | (for [kw [:a :b :c :d] 60 | :let [kwstr (name kw)]] 61 | [kw kwstr]))") 62 | 63 | (t/deftest use-rewrite-clj-node-as-AST 64 | (t/is (= "foo" (-> (zip/of-string "[1 2 3]") 65 | (#'trin/attach-ast-info :foo (constantly "foo")) 66 | first 67 | :ast-info 68 | :foo)) 69 | "Attach data to rewrite-clj node") 70 | (t/is (= [2 "foo"] (-> (zip/of-string "[1 2 3]") 71 | zip/down 72 | zip/right 73 | (#'trin/attach-ast-info :foo (constantly "foo")) 74 | zip/up 75 | zip/root 76 | zip/edn 77 | trin/all-zlocs 78 | (nth 2) 79 | ((juxt zip/sexpr (comp :foo :ast-info first))))) 80 | "Make attached data persistent across zipper movements")) 81 | 82 | (t/deftest analyze-let-loc-test 83 | (t/testing "test let embedded into a do" 84 | (let [embedded-let-with-locals (trin/analyze-loc {} (zip/of-string embedded-let)) 85 | embedded-let-locs (trin/all-zlocs embedded-let-with-locals)] 86 | (t/is (= '#{a b c} (-> embedded-let-with-locals 87 | zip/down 88 | zip/right 89 | zip/right 90 | zip/down 91 | zip/right 92 | zip/right 93 | first 94 | :ast-info 95 | :env 96 | :locals 97 | keys 98 | set)) 99 | "Add locals to env.") 100 | (t/is (= 4 (count (filter (comp #{:local} :op :ast-info first) embedded-let-locs))) 101 | "Identify all op-locals"))) 102 | 103 | (t/testing "test let in let, effectively shadowing" 104 | (let [let-in-let-locs (->> (zip/of-string let-in-let) 105 | (trin/analyze-loc {}) 106 | trin/all-zlocs) 107 | op-local-locs (filter (comp #{:local} :op :ast-info first) let-in-let-locs)] 108 | (t/is (= 5 (count op-local-locs)) 109 | "Identify all op-locals") 110 | (t/is (= 3 (-> (drop 2 op-local-locs) 111 | ffirst 112 | :ast-info 113 | :init)) 114 | "Init in outside let for local is correct") 115 | (let [let-in-let-c-ast (-> (last op-local-locs) 116 | first 117 | :ast-info)] 118 | (t/is (= '(inc c) (:init let-in-let-c-ast)) 119 | "Reference to c local is shadowed in let in let") 120 | (t/is (= '{a {:op :local :local :let :init 1 :init-resolved nil} 121 | b {:op :local :local :let :init a :init-resolved 1} 122 | c {:op :local :local :let :init (inc c) :init-resolved nil}} 123 | (:locals (:env let-in-let-c-ast))) 124 | "Shadow locals"))))) 125 | 126 | (t/deftest analyze-defn-with-arg-test 127 | (t/testing "test simple defn with an arg" 128 | (let [defn-with-arg-locs (->> (zip/of-string defn-with-arg) 129 | (trin/analyze-loc {}) 130 | trin/all-zlocs) 131 | arg-local-in-env (some (comp :locals :env :ast-info first) defn-with-arg-locs) 132 | arg-local-node (first (filter (comp #{:local} :op :ast-info first) defn-with-arg-locs))] 133 | (t/is (= {'kw {:op :local 134 | :arg-id 0 135 | :local :arg}} arg-local-in-env) 136 | "Attach locals based on defn arg.") 137 | (t/is (= {:op :local 138 | :arg-id 0 139 | :local :arg} 140 | (-> (first arg-local-node) 141 | :ast-info 142 | (dissoc :env))) 143 | "Mark reference to arg in defn body.")))) 144 | 145 | (t/deftest analyze-defn-with-varargs-test 146 | (t/testing "test defn with varargs" 147 | (let [defn-with-varargs-locs (->> (zip/of-string defn-with-varargs) 148 | (trin/analyze-loc {}) 149 | (trin/all-zlocs)) 150 | arg-local-in-env (some (comp :locals :env :ast-info first) defn-with-varargs-locs) 151 | arg-local-node (filter (comp #{:local} :op :ast-info first) defn-with-varargs-locs)] 152 | (t/is (= {'kw {:op :local 153 | :arg-id 0 154 | :local :arg} 155 | 'other-kws {:op :local 156 | :arg-id 1 157 | :local :arg 158 | :variadic? true}} arg-local-in-env) 159 | "Attach locals based on defn arg and varargs.") 160 | (t/is (= {:op :local 161 | :arg-id 0 162 | :local :arg} 163 | (-> (ffirst arg-local-node) 164 | :ast-info 165 | (dissoc :env))) 166 | "Mark reference to arg in defn body.") 167 | (t/is (= {:op :local 168 | :arg-id 1 169 | :variadic? true 170 | :local :arg} 171 | (-> (last arg-local-node) 172 | first 173 | :ast-info 174 | (dissoc :env))) 175 | "Mark reference to varargs coll in defn body.")))) 176 | 177 | (t/deftest analyze-defn-with-map-destruct-as-defaults-varargs-test 178 | (t/testing "map destructuring, defaults, as, varargs" 179 | (let [defn-locs (->> (zip/of-string defn-with-map-destruct-as-defaults-varargs) 180 | (trin/analyze-loc {}) 181 | (trin/all-zlocs)) 182 | arg-local-in-env (some (comp :locals :env :ast-info first) defn-locs) 183 | arg-local-node (filter (comp #{:local} :op :ast-info first) defn-locs)] 184 | (t/is (= 185 | {'all-the-things {:arg-id 0 :as? true :local :arg :op :local} 186 | 'bar {:arg-id 0 :local :arg :op :local} 187 | 'foo {:arg-id 0 :default-value "foo" :local :arg :op :local} 188 | 'rest-args {:arg-id 1 :local :arg :op :local :variadic? true}} 189 | arg-local-in-env) 190 | "Recognise all locals in args.") 191 | (t/is (= {:op :local 192 | :arg-id 0 193 | :local :arg 194 | :default-value "foo"} 195 | (-> (ffirst arg-local-node) 196 | :ast-info 197 | (dissoc :env))) 198 | "Mark reference to arg in defn body.")))) 199 | 200 | (t/deftest analyze-defn-nested-and-combined-destructurings-test 201 | (t/testing "nested and combined associative and sequential destructurings" 202 | (let [defn-locs (->> (zip/of-string defn-nested-and-combined-destructurings) 203 | (trin/analyze-loc {}) 204 | (trin/all-zlocs)) 205 | arg-local-in-env (some (comp :locals :env :ast-info first) defn-locs) 206 | arg-local-nodes (filter (comp #{:local} :op :ast-info first) defn-locs)] 207 | (t/is (= {'an-arg {:arg-id 0 :local :arg :op :local} 208 | 'bar {:arg-id 1 :local :arg :op :local} 209 | 'inner {:arg-id 1 :as? true :local :arg :op :local} 210 | 'outer {:arg-id 1 :as? true :local :arg :op :local} 211 | 'rest-args {:arg-id 2 :local :arg :op :local :variadic? true}} 212 | arg-local-in-env) 213 | "Recognise all locals in args") 214 | (t/is (->> (map first arg-local-nodes) 215 | (map :ast-info) 216 | (map :arg-id) 217 | (every? (partial = 1))) 218 | "All used locals are from the second arg.")))) 219 | 220 | (t/deftest analyze-loop-test 221 | (t/testing "analyze loop in terms of locals" 222 | (let [defn-locs (->> (zip/of-string defn-using-loop) 223 | (trin/analyze-loc {}) 224 | (trin/all-zlocs)) 225 | arg-local-in-env (some (comp :locals :env :ast-info first) defn-locs) 226 | arg-local-nodes (filter (comp #{:local} :op :ast-info first) defn-locs)] 227 | (t/is (= {'kw {:init [:a :b :c :d] :init-resolved nil :local :loop :op :local} 228 | 'rest-kws {:init [:a :b :c :d] :init-resolved nil :local :loop :op :local :rest-seq? true}} 229 | arg-local-in-env) 230 | "Recognise all locals in loop.") 231 | (t/is (= {:op :local 232 | :local :loop 233 | :init [:a :b :c :d] 234 | :init-resolved nil} 235 | (-> (ffirst arg-local-nodes) 236 | :ast-info 237 | (dissoc :env))) 238 | "Mark reference to first local.") 239 | (t/is (= {:op :local 240 | :local :loop 241 | :rest-seq? true 242 | :init [:a :b :c :d] 243 | :init-resolved nil} 244 | (-> (last arg-local-nodes) 245 | first 246 | :ast-info 247 | (dissoc :env))) 248 | "Mark reference to rest local.")))) 249 | 250 | (t/deftest analyze-for-with-let-keyword 251 | (t/testing "analyze for with let keyword" 252 | (let [defn-locs (->> (zip/of-string defn-with-for) 253 | (trin/analyze-loc {}) 254 | (trin/all-zlocs)) 255 | ->ast-info (comp :locals :env :ast-info first) 256 | arg-local-in-env (->ast-info (last (filter ->ast-info defn-locs))) 257 | arg-local-nodes (filter (comp #{:local} :op :ast-info first) defn-locs)] 258 | (t/is (= {'kw {:init [:a :b :c :d] :init-resolved nil :local :for :op :local} 259 | 'kwstr {:init '(name kw) :init-resolved nil :local :for :op :local}} 260 | arg-local-in-env) 261 | "Recognise all locals in for") 262 | (t/is (= {:op :local 263 | :local :for 264 | :init [:a :b :c :d] 265 | :init-resolved nil} 266 | (-> (ffirst arg-local-nodes) 267 | :ast-info 268 | (dissoc :env))) 269 | "Mark reference to local bound to element of seq being iterated") 270 | (t/is (= {:op :local 271 | :local :for 272 | :init '(name kw) 273 | :init-resolved nil} 274 | (-> (last arg-local-nodes) 275 | first 276 | :ast-info 277 | (dissoc :env))) 278 | "Mark reference to :let binding in for")))) 279 | --------------------------------------------------------------------------------