├── .github ├── PULL_REQUEST_TEMPLATE └── workflows │ ├── doc-build.yml │ ├── release.yml │ ├── snapshot.yml │ └── test.yml ├── .gitignore ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── epl.html ├── pom.xml ├── project.clj ├── spec ├── ast-ref.edn ├── buildref.sh ├── gen-ref.clj └── quickref.html.tpl └── src ├── main ├── clojure │ └── clojure │ │ └── tools │ │ ├── analyzer.clj │ │ └── analyzer │ │ ├── ast.clj │ │ ├── ast │ │ └── query.clj │ │ ├── env.clj │ │ ├── passes.clj │ │ ├── passes │ │ ├── add_binding_atom.clj │ │ ├── cleanup.clj │ │ ├── collect_closed_overs.clj │ │ ├── constant_lifter.clj │ │ ├── elide_meta.clj │ │ ├── emit_form.clj │ │ ├── index_vector_nodes.clj │ │ ├── source_info.clj │ │ ├── trim.clj │ │ ├── uniquify.clj │ │ └── warn_earmuff.clj │ │ └── utils.clj └── dotnet │ └── packager │ ├── clojure.tools.analyzer.csproj │ └── clojure.tools.analyzer.sln └── test └── clojure └── clojure └── tools └── analyzer ├── core_test.clj ├── passes_test.clj └── query_test.clj /.github/PULL_REQUEST_TEMPLATE: -------------------------------------------------------------------------------- 1 | Hi! Thanks for your interest in contributing to this project. 2 | 3 | Clojure contrib projects do not use GitHub issues or pull requests, and 4 | require a signed Contributor Agreement. If you would like to contribute, 5 | please read more about the CA and sign that first (this can be done online). 6 | 7 | Then go to this project's issue tracker in JIRA to create tickets, update 8 | tickets, or submit patches. For help in creating tickets and patches, 9 | please see: 10 | 11 | - Contributing FAQ: https://clojure.org/dev 12 | - Signing the CA: https://clojure.org/dev/contributor_agreement 13 | - Creating Tickets: https://clojure.org/dev/creating_tickets 14 | - Developing Patches: https://clojure.org/dev/developing_patches 15 | -------------------------------------------------------------------------------- /.github/workflows/doc-build.yml: -------------------------------------------------------------------------------- 1 | name: Build API Docs 2 | 3 | on: 4 | workflow_dispatch: 5 | 6 | jobs: 7 | call-doc-build-workflow: 8 | uses: clojure/build.ci/.github/workflows/doc-build.yml@master 9 | with: 10 | project: clojure/tools.analyzer 11 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Release on demand 2 | 3 | on: 4 | workflow_dispatch: 5 | inputs: 6 | releaseVersion: 7 | description: "Version to release" 8 | required: true 9 | snapshotVersion: 10 | description: "Snapshot version after release" 11 | required: true 12 | 13 | jobs: 14 | call-release: 15 | uses: clojure/build.ci/.github/workflows/release.yml@master 16 | with: 17 | releaseVersion: ${{ github.event.inputs.releaseVersion }} 18 | snapshotVersion: ${{ github.event.inputs.snapshotVersion }} 19 | secrets: inherit -------------------------------------------------------------------------------- /.github/workflows/snapshot.yml: -------------------------------------------------------------------------------- 1 | name: Snapshot on demand 2 | 3 | on: [workflow_dispatch] 4 | 5 | jobs: 6 | call-snapshot: 7 | uses: clojure/build.ci/.github/workflows/snapshot.yml@master 8 | secrets: inherit 9 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | 3 | on: [push] 4 | 5 | jobs: 6 | call-test: 7 | uses: clojure/build.ci/.github/workflows/test.yml@master 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | *.jar 6 | *.class 7 | .lein-deps-sum 8 | .lein-failures 9 | .lein-plugins 10 | .lein-repl-history 11 | 12 | #Visual Studio artifacts 13 | bin/ 14 | obj/ 15 | .vs/ 16 | *.user 17 | *.suo 18 | *.nupkg -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog 2 | ======================================== 3 | * Release 1.2.0 on 19 Feb 2024 4 | * Update parent pom 5 | * Release 1.1.1 on 26 Nov 2022 6 | * Remove JVM-specific code to make this usable for ClojureCLR 7 | * Release 1.1.0 on 14 Sep 2021 8 | * TANAL-134: Remove :init from :def's :children when absent 9 | * Added :refer-clojure :exclude for `update-keys` and `update-vals` being added in Clojure 1.11 10 | * Release 1.0.0 on 18 Feb 2020 11 | * Fixed docstrings 12 | * Release 0.7.0 on 10 Dec 2018 13 | * Handle injected locals in add-binding-atom phase 14 | * Release 0.6.9 on 9 Jun 2015 15 | * Exclude `boolean?` from clojure.core 16 | * Release 0.6.7 on 3 Nov 2015 17 | * Don't elide significant 'quote 18 | * Release 0.6.6 on 23 Apr 2015 19 | * Fix emit-form for :host-field 20 | * Release 0.6.5 on 23 Feb 2015 21 | * Small performance enhancements 22 | * Fixed some metadata handling 23 | * Removed :ctx.invoke, derive :ctx/return from :ctx/expr 24 | * Renamed resolve-var to resolve-sym 25 | * Attached resolved op to :raw-forms 26 | * Added var special form 27 | * Release 0.6.4 on 20 Nov 2014 28 | * Fixed a bug in the pass scheduler regarding transitive deps 29 | * Added reduced support for update-children, walk, prewalk and postwalk 30 | * Fixed parsing of catch expressions outside a try block 31 | * Release 0.6.3 on 03 Oct 2014 32 | * Preserve correct meta on emit-form 33 | * Preserve :raw-forms in elide-meta 34 | * Better source-info propagation 35 | * Release 0.6.2 on 27 Oct 2014 36 | * Fixes and improvements for looping pass scheduling 37 | * Performance improvements on the scheduled pass function 38 | * Release 0.6.1 on 13 Oct 2014 39 | * Significant performance enhancements 40 | * Fixed scheduling of looping passes 41 | * Uniquify :env :locals only if the :uniquify/uniquify-env pass-opt is true 42 | * Release 0.6.0 on 18 Sep 2014 43 | * Added pass scheduler (clojure.tools.analyzer.passes/schedule) and configured all the passes 44 | * Changed the interface of the collect-closed-overs pass 45 | * Changed the interface of the add-binding-atom pass 46 | * Removed the (experimental) trim pass 47 | * Release 0.5.3 on 31 Aug 2014 48 | * Made the source clojure-clr compatible 49 | * Added butlast+last to utils 50 | * Release 0.5.2 on 20 Aug 2014 51 | * Compare contexts with isa? rather than = 52 | * Release 0.5.1 on 09 Aug 2014 53 | * Removed collect pass 54 | * Moved collect-closed-overs pass to its own namespace 55 | * Release 0.5.0 on 29 Jul 2014 56 | * Made :host-field and :host-interop :assignable? 57 | * Release 0.4.0 on 26 Jul 2014 58 | * BREAKING CHANGE: The :class field for :new and :catch nodes are now children nodes rather than symbols 59 | * More fine-grained elide-meta 60 | * Release 0.3.0 on 21 Jun 2014 61 | * BREAKING API CHANGE: :context is now either :ctx/statement, :ctx/return, :ctx/expr or a keyword derived from one of those 62 | * elide-meta: elides can be any IFn, not only a set 63 | * analyze :symbol will not throw when a Var is not found 64 | * Release 0.2.3 on 16 Jun 2014 65 | * Preserve :raw-forms for macroexpanded symbols 66 | * Add :end-line :end-column info to source-info (only when directly available) 67 | * Release 0.2.2 on 13 Jun 2014 68 | * :fn node can be wrapped by :with-meta 69 | * Remove :meta from :def :children when elide-meta removes it 70 | * Release 0.2.1 on 08 Jun 2014 71 | * Made constant-lift preserve the original AST fields 72 | * Made elide-meta discard all meta on form if metadata becomes nil 73 | * Release 0.2.0 on 05 Jun 2014 74 | * BREAKING API CHANGE: Add global-env interface, move :namespaces from env to the global env 75 | * Preserve original forms under :raw-forms in case of macroexpansion 76 | * Open analyze-form dispatch 77 | * Fixed collect-closed-overs for letfn* 78 | * Make cleanup work on :env :locals 79 | * Release 0.1.0-beta13 on 11 Mar 2014 80 | * Fix elide-meta pass 81 | * Release 0.1.0-beta12 on 25 Apr 2014 82 | * Annotated top-level nodes with :top-level true 83 | * Moved rseqv and into! to the c.t.a.utils namespace 84 | * Don't uniquify "constructed" locals 85 | * Preserve :locals in :env, uniquify locals :name in :env :locals 86 | * Release 0.1.0-beta11 on 18 Apr 2014 87 | * Reduced the number of calls to `symbol`, leading to some performance improvements 88 | * Performance improvements on the uniquify pass 89 | * BREAKING API CHANGE: ast/children* now returns a vector of [key node] rather than 90 | a vector of nodes 91 | * Performance improvement on ast/update-children 92 | * Added options set to emit-form 93 | * Release 0.1.0-beta10 on 1 Apr 2014 94 | * Don't discard macroexpanded form meta, merge it with &form meta 95 | * Improvements on source-info handling 96 | * Release 0.1.0-beta9 on 29 Mar 2014 97 | * Fixed a bug in constant-lift regarding array-maps 98 | * Fixed elide-meta implementation 99 | * :const nodes will have :meta only if the const object is an IObj 100 | * Release 0.1.0-beta8 on 11 Mar 2014 101 | * Removed :name in env for the :fn name, moved in a tools.analyzer.jvm pass 102 | * Added docstrings 103 | * Release 0.1.0-beta7 on 28 Feb 2014 104 | * Fix macroexpand implementation 105 | * Release 0.1.0-beta5 on 26 Feb 2014 106 | * Unwrap the try if there's no catch/finally 107 | * Fixed uniquify pass on letfn bindings 108 | * Correctly quote :arglists meta in def sym 109 | * Release 0.1.0-beta4 on 17 Feb 2014 110 | * Analyze throws on `(quote)` 111 | * General code cleanup, added docstrings 112 | * Changed :loop-locals to hold the count of locals rather than their form 113 | Holding their form was problematic since the uniquify pass would invaldiate those 114 | * Attached :once to :fn nodes when ^:once fn* 115 | * Release 0.1.0-beta3 on 15 Feb 2014 116 | * Allowed :top-level collecting for collect-closed-overs 117 | * Release 0.1.0-beta2 on 14 Feb 2014 118 | * Fixed fn name munging 119 | * Release 0.1.0-beta1 on 11 Feb 2014 120 | * First beta release 121 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This is a [Clojure contrib] project. 2 | 3 | Under the Clojure contrib [guidelines], this project cannot accept 4 | pull requests. All patches must be submitted via [JIRA]. 5 | 6 | See [Contributing] on the Clojure website for 7 | more information on how to contribute. 8 | 9 | [Clojure contrib]: https://clojure.org/community/contrib_libs 10 | [Contributing]: https://clojure.org/community/contributing 11 | [JIRA]: https://clojure.atlassian.net/browse/TANAL 12 | [guidelines]: https://clojure.org/community/contrib_howto 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | 205 | 206 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # tools.analyzer 2 | 3 | An analyzer for host agnostic Clojure code, written in Clojure and producing AST in EDN. 4 | 5 | I gave a talk on tools.analyzer[.jvm] at ClojureX in December 2015. Video [here](https://www.youtube.com/watch?v=oZyt93lmF5s) 6 | 7 | Timothy Baldridge gave a talk on tools.analyzer[.jvm] at Clojure/West in 8 | March 2014. Video 9 | [here](https://www.youtube.com/watch?v=KhRQmT22SSg&list=PLZdCLR02grLp__wRg5OTavVj4wefg69hM&index=11). 10 | 11 | Note that the analyzer in this library should not to be used directly as it lacks any knowledge about host-specific special forms and it should only be considered as a building platform for host-specific analyzers. 12 | Currently the following platform specific analyzers written on top of tools.analyzer exist: [tools.analyzer.jvm](https://github.com/clojure/tools.analyzer.jvm), [tools.analyzer.js](https://github.com/clojure/tools.analyzer.js) 13 | 14 | * [Example Usage](#example-usage) 15 | * [Quickref](#quickref) 16 | * [Releases and Dependency Information](#releases-and-dependency-information) 17 | * [Changelog](#changelog) 18 | * [API Index](#api-index) 19 | * [Developer Information](#developer-information) 20 | * [License](#license) 21 | 22 | [Quickref](https://clojure.github.io/tools.analyzer/spec/quickref.html) 23 | ======================================== 24 | 25 | ## Example Usage 26 | `clojure.tools.analyzer/analyze` will not work out of the box, as it requires a number of entry-points to be set. 27 | Here's what could happen trying to use `clojure.tools.analyzer/analyze` directly: 28 | ```clojure 29 | clojure.tools.analyzer> (analyze 'a {}) 30 | Attempting to call unbound fn: #'clojure.tools.analyzer/macroexpand-1 31 | [Thrown class java.lang.IllegalStateException] 32 | ``` 33 | 34 | At the moment there exist two official analyzers written on top of [tools.analyzer](https://github.com/clojure/tools.analyzer): [tools.analyzer.jvm](https://github.com/clojure/tools.analyzer.jvm) for clojure on the JVM and [tools.analyzer.js](https://github.com/clojure/tools.analyzer.js) for clojurescript. 35 | We will use [tools.analyzer.jvm](https://github.com/clojure/tools.analyzer.jvm) for those examples. 36 | 37 | Here's a simplified version of how `clojure.tools.analyzer.jvm/analyze` is defined: 38 | ```clojure 39 | (require '[clojure.tools.analyzer :as ana]) 40 | (require '[clojure.tools.analyzer.env :as env]) 41 | (defn analyze [form env] 42 | (binding [ana/macroexpand-1 macroexpand-1 43 | ana/create-var create-var 44 | ana/parse parse 45 | ana/var? var?] 46 | (env/ensure (global-env) 47 | (run-passes (-analyze form env)))))) 48 | ``` 49 | 50 | Here, `-analyze` is a multimethod that defaults to `ana/analyze` and defines analysis methods for the JVM specific special forms, `global-env` is a function that returns a global environment for the JVM analyzer and `run-passes` is a function that takes an AST and applies a number of passes to it. 51 | 52 | The `tools.analyzer.jvm` [README](https://github.com/clojure/tools.analyzer.jvm#example-usage) contains more examples on how the `analyze` function works as well as a reference for all the nodes it can return. 53 | 54 | One of the most important features of `tools.analyzer` is the ability to walk generically through the AST nodes, this has been immensely useful to write most of the passes used by the various analyzers. 55 | The `tools.analyzer.ast` namespace provides a number of functions that implement various generic AST walking strategies. 56 | 57 | The `children` function returns a vector of the children nodes of the current node (the output has been elided and pretty-printed for clarity): 58 | ```clojure 59 | clojure.tools.analyzer.jvm> (require '[clojure.tools.analyzer.ast :as ast]) 60 | nil 61 | clojure.tools.analyzer.jvm> (ast/children (analyze '(do 1 2 :foo))) 62 | [{:op :const, 63 | :id 0, 64 | :type :number, 65 | :val 1, 66 | :form 1, 67 | ...} 68 | {:op :const, 69 | :id 1, 70 | :type :number, 71 | :val 2, 72 | :form 2, 73 | ...} 74 | {:op :const, 75 | :id 3, 76 | :type :keyword, 77 | :val :foo, 78 | :form :foo, 79 | ...}] 80 | ``` 81 | 82 | If we want to access a flattened view of all the nodes of an AST, we can use the `nodes` function: 83 | ```clojure 84 | clojure.tools.analyzer.jvm> (ast/nodes (analyze '[1 (+ 1 2)])) 85 | ({:op :vector, 86 | :top-level true, 87 | :items 88 | [{:op :const, 89 | :type :number, 90 | :val 1, 91 | ...} 92 | {:op :static-call, 93 | :class clojure.lang.Numbers, 94 | :method add, 95 | :form (. clojure.lang.Numbers (add 1 2)), 96 | :args [{:op :const, 97 | :val 1, 98 | ...} 99 | {:op :const, 100 | :val 2, 101 | ...}], 102 | ...}] 103 | :form [1 (+ 1 2)], 104 | ...} 105 | {:op :const, 106 | :type :number, 107 | :val 1, 108 | ...} 109 | {:op :static-call, 110 | :class clojure.lang.Numbers, 111 | :method add, 112 | :form (. clojure.lang.Numbers (add 1 2)), 113 | :args [{:op :const, 114 | :val 1, 115 | ...} 116 | {:op :const, 117 | :val 2, 118 | ...}], 119 | ...} 120 | ..) 121 | ``` 122 | 123 | The `update-children` function takes an AST node and a function and replaces the children nodes of the given node with the result of applying the function to each children node. 124 | ```clojure 125 | clojure.tools.analyzer.jvm> (ast/update-children (analyze '(do 1 (+ 1 2) :foo)) 126 | #(assoc % :visited true)) 127 | {:op :do 128 | :statements 129 | [{:op :const, 130 | :val 1, 131 | :visited true, 132 | ...} 133 | {:op :static-call, 134 | :class clojure.lang.Numbers, 135 | :method add, 136 | :visited true, 137 | :args [{:op :const 138 | :val 1, 139 | ...} 140 | {:op :const, 141 | :val 2, 142 | ...}], 143 | ...}] 144 | :ret 145 | {:op :const, 146 | :val :foo, 147 | :visited true, 148 | ...}, 149 | ...} 150 | ``` 151 | If it's desirable to walk all the AST applying a function to all the nodes and the children nodes, one of `walk`, `prewalk` or `postwalk` should be used, read the docstrings of the three functions to understand the differences. 152 | Here's the previous example using `prewalk` instead of `update-children`: 153 | ```clojure 154 | clojure.tools.analyzer.jvm> (ast/prewalk (analyze '(do 1 (+ 1 2) :foo)) 155 | #(assoc % :visited true)) 156 | {:op :do 157 | :visited true, 158 | :statements 159 | [{:op :const, 160 | :val 1, 161 | :visited true, 162 | ...} 163 | {:op :static-call, 164 | :class clojure.lang.Numbers, 165 | :method add, 166 | :visited true, 167 | :args [{:op :const 168 | :val 1, 169 | :visited true, 170 | ...} 171 | {:op :const, 172 | :val 2, 173 | :visited true, 174 | ...}], 175 | ...}] 176 | :ret 177 | {:op :const, 178 | :val :foo, 179 | :visited true, 180 | ...}, 181 | ...} 182 | ``` 183 | As you can see, this time all the nodes have been marked `:visited`. 184 | 185 | Since version `0.6.0`, passes can be scheduled automatically using `clojure.tools.analyzer.passes/schedule` rather than having to compose them and sort out pass dependencies manually, refer to its docstrings and examples from `tools.analyzer.jvm` for more info. 186 | 187 | ## SPONSORSHIP 188 | 189 | * Cognitect (https://cognitect.com/) has sponsored tools.analyzer development (https://groups.google.com/d/msg/clojure/iaP16MHpX0E/EMtnGmOz-rgJ) 190 | * Ambrose BS (https://twitter.com/ambrosebs) has sponsored tools.analyzer development in his typed clojure campaign (https://www.indiegogo.com/projects/typed-clojure). 191 | 192 | ## YourKit 193 | 194 | YourKit has given an open source license for their profiler, greatly simplifying the profiling of tools.analyzer performance. 195 | 196 | YourKit is kindly supporting open source projects with its full-featured Java Profiler. YourKit, LLC is the creator of innovative and intelligent tools for profiling Java and .NET applications. Take a look at YourKit's leading software products: 197 | 198 | * YourKit Java Profiler and 199 | * YourKit .NET Profiler. 200 | 201 | Releases and Dependency Information 202 | ======================================== 203 | 204 | Latest stable release: 1.2.0 205 | 206 | * [All Released Versions](https://search.maven.org/#search%7Cgav%7C1%7Cg%3A%22org.clojure%22%20AND%20a%3A%22tools.analyzer%22) 207 | * [Development Snapshot Versions](https://clojure.org/releases/downloads#_using_clojure_snapshot_releases) 208 | 209 | [Leiningen](https://github.com/technomancy/leiningen) dependency information: 210 | 211 | ```clojure 212 | [org.clojure/tools.analyzer "1.2.0"] 213 | ``` 214 | [Maven](https://maven.apache.org/) dependency information: 215 | 216 | ```xml 217 | 218 | org.clojure 219 | tools.analyzer 220 | 1.2.0 221 | 222 | ``` 223 | 224 | [Changelog](CHANGELOG.md) 225 | ======================================== 226 | 227 | API Index 228 | ======================================== 229 | 230 | * [API index](https://clojure.github.io/tools.analyzer) 231 | 232 | Developer Information 233 | ======================================== 234 | 235 | * [GitHub project](https://github.com/clojure/tools.analyzer) 236 | * [Bug Tracker](https://clojure.atlassian.net/browse/TANAL) 237 | * [Continuous Integration](https://github.com/clojure/tools.analyzer/actions/workflows/test.yml) 238 | 239 | ## License 240 | 241 | Copyright © Nicola Mometto, Rich Hickey & contributors. 242 | 243 | Distributed under the Eclipse Public License, the same as Clojure. 244 | -------------------------------------------------------------------------------- /epl.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Eclipse Public License - Version 1.0 8 | 25 | 26 | 27 | 28 | 29 | 30 |

Eclipse Public License - v 1.0

31 | 32 |

THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS 35 | AGREEMENT.

36 | 37 |

1. DEFINITIONS

38 | 39 |

"Contribution" means:

40 | 41 |

a) in the case of the initial Contributor, the initial 42 | code and documentation distributed under this Agreement, and

43 |

b) in the case of each subsequent Contributor:

44 |

i) changes to the Program, and

45 |

ii) additions to the Program;

46 |

where such changes and/or additions to the Program 47 | originate from and are distributed by that particular Contributor. A 48 | Contribution 'originates' from a Contributor if it was added to the 49 | Program by such Contributor itself or anyone acting on such 50 | Contributor's behalf. Contributions do not include additions to the 51 | Program which: (i) are separate modules of software distributed in 52 | conjunction with the Program under their own license agreement, and (ii) 53 | are not derivative works of the Program.

54 | 55 |

"Contributor" means any person or entity that distributes 56 | the Program.

57 | 58 |

"Licensed Patents" mean patent claims licensable by a 59 | Contributor which are necessarily infringed by the use or sale of its 60 | Contribution alone or when combined with the Program.

61 | 62 |

"Program" means the Contributions distributed in accordance 63 | with this Agreement.

64 | 65 |

"Recipient" means anyone who receives the Program under 66 | this Agreement, including all Contributors.

67 | 68 |

2. GRANT OF RIGHTS

69 | 70 |

a) Subject to the terms of this Agreement, each 71 | Contributor hereby grants Recipient a non-exclusive, worldwide, 72 | royalty-free copyright license to reproduce, prepare derivative works 73 | of, publicly display, publicly perform, distribute and sublicense the 74 | Contribution of such Contributor, if any, and such derivative works, in 75 | source code and object code form.

76 | 77 |

b) Subject to the terms of this Agreement, each 78 | Contributor hereby grants Recipient a non-exclusive, worldwide, 79 | royalty-free patent license under Licensed Patents to make, use, sell, 80 | offer to sell, import and otherwise transfer the Contribution of such 81 | Contributor, if any, in source code and object code form. This patent 82 | license shall apply to the combination of the Contribution and the 83 | Program if, at the time the Contribution is added by the Contributor, 84 | such addition of the Contribution causes such combination to be covered 85 | by the Licensed Patents. The patent license shall not apply to any other 86 | combinations which include the Contribution. No hardware per se is 87 | licensed hereunder.

88 | 89 |

c) Recipient understands that although each Contributor 90 | grants the licenses to its Contributions set forth herein, no assurances 91 | are provided by any Contributor that the Program does not infringe the 92 | patent or other intellectual property rights of any other entity. Each 93 | Contributor disclaims any liability to Recipient for claims brought by 94 | any other entity based on infringement of intellectual property rights 95 | or otherwise. As a condition to exercising the rights and licenses 96 | granted hereunder, each Recipient hereby assumes sole responsibility to 97 | secure any other intellectual property rights needed, if any. For 98 | example, if a third party patent license is required to allow Recipient 99 | to distribute the Program, it is Recipient's responsibility to acquire 100 | that license before distributing the Program.

101 | 102 |

d) Each Contributor represents that to its knowledge it 103 | has sufficient copyright rights in its Contribution, if any, to grant 104 | the copyright license set forth in this Agreement.

105 | 106 |

3. REQUIREMENTS

107 | 108 |

A Contributor may choose to distribute the Program in object code 109 | form under its own license agreement, provided that:

110 | 111 |

a) it complies with the terms and conditions of this 112 | Agreement; and

113 | 114 |

b) its license agreement:

115 | 116 |

i) effectively disclaims on behalf of all Contributors 117 | all warranties and conditions, express and implied, including warranties 118 | or conditions of title and non-infringement, and implied warranties or 119 | conditions of merchantability and fitness for a particular purpose;

120 | 121 |

ii) effectively excludes on behalf of all Contributors 122 | all liability for damages, including direct, indirect, special, 123 | incidental and consequential damages, such as lost profits;

124 | 125 |

iii) states that any provisions which differ from this 126 | Agreement are offered by that Contributor alone and not by any other 127 | party; and

128 | 129 |

iv) states that source code for the Program is available 130 | from such Contributor, and informs licensees how to obtain it in a 131 | reasonable manner on or through a medium customarily used for software 132 | exchange.

133 | 134 |

When the Program is made available in source code form:

135 | 136 |

a) it must be made available under this Agreement; and

137 | 138 |

b) a copy of this Agreement must be included with each 139 | copy of the Program.

140 | 141 |

Contributors may not remove or alter any copyright notices contained 142 | within the Program.

143 | 144 |

Each Contributor must identify itself as the originator of its 145 | Contribution, if any, in a manner that reasonably allows subsequent 146 | Recipients to identify the originator of the Contribution.

147 | 148 |

4. COMMERCIAL DISTRIBUTION

149 | 150 |

Commercial distributors of software may accept certain 151 | responsibilities with respect to end users, business partners and the 152 | like. While this license is intended to facilitate the commercial use of 153 | the Program, the Contributor who includes the Program in a commercial 154 | product offering should do so in a manner which does not create 155 | potential liability for other Contributors. Therefore, if a Contributor 156 | includes the Program in a commercial product offering, such Contributor 157 | ("Commercial Contributor") hereby agrees to defend and 158 | indemnify every other Contributor ("Indemnified Contributor") 159 | against any losses, damages and costs (collectively "Losses") 160 | arising from claims, lawsuits and other legal actions brought by a third 161 | party against the Indemnified Contributor to the extent caused by the 162 | acts or omissions of such Commercial Contributor in connection with its 163 | distribution of the Program in a commercial product offering. The 164 | obligations in this section do not apply to any claims or Losses 165 | relating to any actual or alleged intellectual property infringement. In 166 | order to qualify, an Indemnified Contributor must: a) promptly notify 167 | the Commercial Contributor in writing of such claim, and b) allow the 168 | Commercial Contributor to control, and cooperate with the Commercial 169 | Contributor in, the defense and any related settlement negotiations. The 170 | Indemnified Contributor may participate in any such claim at its own 171 | expense.

172 | 173 |

For example, a Contributor might include the Program in a commercial 174 | product offering, Product X. That Contributor is then a Commercial 175 | Contributor. If that Commercial Contributor then makes performance 176 | claims, or offers warranties related to Product X, those performance 177 | claims and warranties are such Commercial Contributor's responsibility 178 | alone. Under this section, the Commercial Contributor would have to 179 | defend claims against the other Contributors related to those 180 | performance claims and warranties, and if a court requires any other 181 | Contributor to pay any damages as a result, the Commercial Contributor 182 | must pay those damages.

183 | 184 |

5. NO WARRANTY

185 | 186 |

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS 188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, 189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 191 | responsible for determining the appropriateness of using and 192 | distributing the Program and assumes all risks associated with its 193 | exercise of rights under this Agreement , including but not limited to 194 | the risks and costs of program errors, compliance with applicable laws, 195 | damage to or loss of data, programs or equipment, and unavailability or 196 | interruption of operations.

197 | 198 |

6. DISCLAIMER OF LIABILITY

199 | 200 |

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT 201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

208 | 209 |

7. GENERAL

210 | 211 |

If any provision of this Agreement is invalid or unenforceable under 212 | applicable law, it shall not affect the validity or enforceability of 213 | the remainder of the terms of this Agreement, and without further action 214 | by the parties hereto, such provision shall be reformed to the minimum 215 | extent necessary to make such provision valid and enforceable.

216 | 217 |

If Recipient institutes patent litigation against any entity 218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 219 | Program itself (excluding combinations of the Program with other 220 | software or hardware) infringes such Recipient's patent(s), then such 221 | Recipient's rights granted under Section 2(b) shall terminate as of the 222 | date such litigation is filed.

223 | 224 |

All Recipient's rights under this Agreement shall terminate if it 225 | fails to comply with any of the material terms or conditions of this 226 | Agreement and does not cure such failure in a reasonable period of time 227 | after becoming aware of such noncompliance. If all Recipient's rights 228 | under this Agreement terminate, Recipient agrees to cease use and 229 | distribution of the Program as soon as reasonably practicable. However, 230 | Recipient's obligations under this Agreement and any licenses granted by 231 | Recipient relating to the Program shall continue and survive.

232 | 233 |

Everyone is permitted to copy and distribute copies of this 234 | Agreement, but in order to avoid inconsistency the Agreement is 235 | copyrighted and may only be modified in the following manner. The 236 | Agreement Steward reserves the right to publish new versions (including 237 | revisions) of this Agreement from time to time. No one other than the 238 | Agreement Steward has the right to modify this Agreement. The Eclipse 239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may 240 | assign the responsibility to serve as the Agreement Steward to a 241 | suitable separate entity. Each new version of the Agreement will be 242 | given a distinguishing version number. The Program (including 243 | Contributions) may always be distributed subject to the version of the 244 | Agreement under which it was received. In addition, after a new version 245 | of the Agreement is published, Contributor may elect to distribute the 246 | Program (including its Contributions) under the new version. Except as 247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no 248 | rights or licenses to the intellectual property of any Contributor under 249 | this Agreement, whether expressly, by implication, estoppel or 250 | otherwise. All rights in the Program not expressly granted under this 251 | Agreement are reserved.

252 | 253 |

This Agreement is governed by the laws of the State of New York and 254 | the intellectual property laws of the United States of America. No party 255 | to this Agreement will bring a legal action under this Agreement more 256 | than one year after the cause of action arose. Each party waives its 257 | rights to a jury trial in any resulting litigation.

258 | 259 | 260 | 261 | 262 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | tools.analyzer 5 | 1.2.1-SNAPSHOT 6 | tools.analyzer 7 | An analyzer for Clojure code, written in Clojure and producing AST in EDN 8 | 9 | 10 | 1.9.0 11 | 12 | 13 | 14 | org.clojure 15 | pom.contrib 16 | 1.3.0 17 | 18 | 19 | 20 | 21 | bronsa 22 | Nicola Mometto 23 | 24 | 25 | 26 | 27 | scm:git:git://github.com/clojure/tools.analyzer.git 28 | scm:git:git://github.com/clojure/tools.analyzer.git 29 | https://github.com/clojure/tools.analyzer 30 | HEAD 31 | 32 | 33 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojure/tools.analyzer "1.0.1-SNAPSHOT" 2 | :description "An analyzer for Clojure code, written in Clojure and producing AST in EDN." 3 | :url "https://github.com/clojure/tools.analyzer" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :source-paths ["src/main/clojure"] 7 | :test-paths ["src/test/clojure"] 8 | :dependencies [[org.clojure/clojure "1.10.3"] 9 | [com.datomic/datomic-free "0.9.5327" :scope "provided" :exclusions [joda-time]]] 10 | :repositories [["sonatype" "https://oss.sonatype.org/content/repositories/releases"] 11 | ["snapshots" "https://oss.sonatype.org/content/repositories/snapshots"]]) 12 | -------------------------------------------------------------------------------- /spec/ast-ref.edn: -------------------------------------------------------------------------------- 1 | {:all-keys 2 | 3 | [[:op "The node op"] 4 | [:form "The clojure form from which the node originated"] 5 | [:env "The environment map"] 6 | ^:optional 7 | [:children "A vector of keywords, representing the children nodes of this node, in order of evaluation"] 8 | ^:optional 9 | [:raw-forms "If this node's :form has been macroexpanded, a sequence of all the intermediate forms from the original form to the macroexpanded form"] 10 | ^:optional 11 | [:top-level "`true` if this is the root node"]] 12 | 13 | :node-keys 14 | [{:op :binding 15 | :doc "Node for a binding symbol" 16 | :keys [[:form "The binding symbol"] 17 | [:name "The binding symbol"] 18 | [:local "One of :arg, :catch, :fn, :let, :letfn or :loop"] 19 | ^:optional 20 | [:arg-id "When :local is :arg, the parameter index"] 21 | ^:optional 22 | [:variadic? "When :local is :arg, a boolean indicating whether this parameter binds to a variable number of arguments"] 23 | ^:optional ^:children 24 | [:init "When :local is :let, :letfn or :loop, an AST node representing the bound value"]]} 25 | {:op :catch 26 | :doc "Node for a catch expression" 27 | :keys [[:form "`(catch class local body*)`"] 28 | ^:children 29 | [:class "A :maybe-class AST node representing the type of exception to catch"] 30 | ^:children 31 | [:local "The :binding AST node for the caught exception"] 32 | ^:children 33 | [:body "Synthetic :do AST node (with :body? `true`) representing the body of the catch clause"]]} 34 | {:op :const 35 | :doc "Node for a constant literal or a quoted collection literal" 36 | :keys [[:form "A constant literal or a quoted collection literal"] 37 | [:literal? "`true`"] 38 | [:type "one of :nil, :bool, :keyword, :symbol, :string, :number, :type, :record, :map, :vector, :set, :seq, :char, :regex, :class, :var, or :unknown"] 39 | [:val "The value of the constant node"] 40 | ^:optional ^:children 41 | [:meta "An AST node representing the metadata of the constant value, if present. The node will be either a :map node or a :const node with :type :map"]]} 42 | {:op :def 43 | :doc "Node for a def special-form expression" 44 | :keys [[:form "`(def name docstring? init?)`"] 45 | [:name "The var symbol to define in the current namespace"] 46 | [:var "The var object created (or found, if it already existed) named by the symbol :name in the current namespace"] 47 | ^:optional ^:children 48 | [:meta "An AST node representing the metadata attached to :name, if present. The node will be either a :map node or a :const node with :type :map"] 49 | ^:optional ^:children 50 | [:init "An AST node representing the initial value of the var"] 51 | ^:optional 52 | [:doc "The docstring for this var"]]} 53 | {:op :do 54 | :doc "Node for a do special-form expression or for another special-form's body" 55 | :keys [[:form "`(do statement* ret)`"] 56 | ^:children 57 | [:statements "A vector of AST nodes representing all but the last expression in the do body"] 58 | ^:children 59 | [:ret "An AST node representing the last expression in the do body (the block's return value)"] 60 | ^:optional 61 | [:body? "`true` if this node is a synthetic body"]]} 62 | {:op :fn 63 | :doc "Node for a fn* special-form expression" 64 | :keys [[:form "`(fn* name? [arg*] body*)` or `(fn* name? method*)`"] 65 | [:variadic? "`true` if this function contains a variadic arity method"] 66 | [:max-fixed-arity "The number of arguments taken by the fixed-arity method taking the most arguments"] 67 | ^:optional ^:children 68 | [:local "A :binding AST node with :local :fn representing the function's local name, if one is supplied"] 69 | ^:children 70 | [:methods "A vector of :fn-method AST nodes representing the fn method arities"] 71 | [:once "`true` if the fn is marked as `^:once fn*`, meaning it will only be executed once and thus allowing for the clearing of closed-over locals"]]} 72 | {:op :fn-method 73 | :doc "Node for an arity method in a fn* expression" 74 | :keys [[:form "`([arg*] body*)`"] 75 | [:loop-id "Unique symbol identifying this method as a target for recursion"] 76 | [:variadic? "`true` if this fn-method takes a variable number of arguments"] 77 | ^:children 78 | [:params "A vector of :binding AST nodes with :local :arg representing this fn-method args"] 79 | [:fixed-arity "The number of non-variadic args this fn-method takes"] 80 | ^:children 81 | [:body "Synthetic :do node (with :body? `true`) representing the body of this fn-method"]]} 82 | {:op :host-call 83 | :doc "Node for a host interop call" 84 | :keys [[:form "`(.method target arg*)`"] 85 | [:method "Symbol naming the method to call"] 86 | ^:children 87 | [:target "An AST node representing the target object"] 88 | ^:children 89 | [:args "A vector of AST nodes representing the args passed to the method call"]]} 90 | {:op :host-field 91 | :doc "Node for a host interop field access" 92 | :keys [[:form "`(.-field target)`"] 93 | [:field "Symbol naming the field to access"] 94 | ^:children 95 | [:target "An AST node representing the target object"] 96 | [:assignable? "`true`"]]} 97 | {:op :host-interop 98 | :doc "Node for a no-arg host interop call or for a host interop field access" 99 | :keys [[:form "`(. target m-or-f)`"] 100 | ^:children 101 | [:target "An AST node representing the target object"] 102 | [:m-or-f "Symbol naming the no-arg method or field to access in the target"] 103 | [:assignable? "`true`"]]} 104 | {:op :if 105 | :doc "Node for an if special-form expression" 106 | :keys [[:form "`(if test then else?)`"] 107 | ^:children 108 | [:test "An AST node representing the test expression"] 109 | ^:children 110 | [:then "An AST node representing the expression's return value if :test evaluated to a truthy value"] 111 | ^:children 112 | [:else "An AST node representing the expression's return value if :test evaluated to a falsey value, if not supplied it will default to a :const node representing nil"]]} 113 | {:op :invoke 114 | :doc "Node for an invoke expression" 115 | :keys [[:form "`(f arg*)`"] 116 | ^:children 117 | [:fn "An AST node representing the function to invoke"] 118 | ^:children 119 | [:args "A vector of AST nodes representing the args to the function"] 120 | ^:optional 121 | [:meta "Map of metadata attached to the invoke :form"]]} 122 | {:op :let 123 | :doc "Node for a let* special-form expression" 124 | :keys [[:form "`(let* [binding*] body*)`"] 125 | ^:children 126 | [:bindings "A vector of :binding AST nodes with :local :let"] 127 | ^:children 128 | [:body "Synthetic :do node (with :body? `true`) representing the body of the let expression"]]} 129 | {:op :letfn 130 | :doc "Node for a letfn* special-form expression" 131 | :keys [[:form "`(letfn* [binding*] body*)`"] 132 | ^:children 133 | [:bindings "A vector of :binding AST nodes with :local :letfn"] 134 | ^:children 135 | [:body "Synthetic :do node (with :body? `true`) representing the body of the letfn expression"]]} 136 | {:op :local 137 | :doc "Node for a local symbol" 138 | :keys [[:form "The local symbol"] 139 | [:name "The local symbol"] 140 | [:local "One of :arg, :catch, :fn, :let, :letfn or :loop"] 141 | ^:optional 142 | [:arg-id "When :local is :arg, the parameter index"] 143 | [:assignable? "`true` if the local is mutable"] 144 | ^:optional 145 | [:variadic? "When :local is :arg, a boolean indicating whether this parameter binds to a variable number of arguments"]]} 146 | {:op :loop 147 | :doc "Node a loop* special-form expression" 148 | :keys [[:form "`(loop* [binding*] body*)`"] 149 | ^:children 150 | [:bindings "A vector of :binding AST nodes with :local :loop"] 151 | ^:children 152 | [:body "Synthetic :do node (with :body? `true`) representing the body of the loop expression"] 153 | [:loop-id "Unique symbol identifying this loop as a target for recursion"]]} 154 | {:op :map 155 | :doc "Node for a map literal" 156 | :keys [[:form "`{[key val]*}`"] 157 | ^:children 158 | [:keys "A vector of AST nodes representing the keys of the map"] 159 | ^:children 160 | [:vals "A vector of AST nodes representing the vals of the map"]]} 161 | {:op :maybe-class 162 | :doc "Node for a not-namespaced symbol that couldn't be resolved as a var" 163 | :keys [[:form "The not namespaced symbol"] 164 | [:class "The not namespaced symbol that might represent a class"]]} 165 | {:op :maybe-host-form 166 | :doc "Node for namespaced symbol that couldn't be resolved as a var" 167 | :keys [[:form "The namespaced symbol"] 168 | [:class "The namespace part of the symbol, as a symbol"] 169 | [:field "The name part of the symbol, as a symbol"]]} 170 | {:op :new 171 | :doc "Node for a new special-form expression" 172 | :keys [[:form "`(new Class arg*)`"] 173 | ^:children 174 | [:class "A :maybe-class AST node :class representing the Class to instantiate"] 175 | ^:children 176 | [:args "A vector of AST nodes representing the arguments passed to the Class constructor"]]} 177 | {:op :quote 178 | :doc "Node for a quote special-form expression" 179 | :keys [[:form "`(quote expr)`"] 180 | ^:children 181 | [:expr "A :const AST node representing the quoted value"] 182 | [:literal? "`true`"]]} 183 | {:op :recur 184 | :doc "Node for a recur special-form expression" 185 | :keys [[:form "`(recur expr*)`"] 186 | ^:children 187 | [:exprs "A vector of AST nodes representing the new bound values for the loop binding on the next loop iteration"] 188 | [:loop-id "Unique symbol identifying the enclosing loop target"]]} 189 | {:op :set 190 | :doc "Node for a set literal" 191 | :keys [[:form "`#{item*}`"] 192 | ^:children 193 | [:items "A vector of AST nodes representing the items of the set"]]} 194 | {:op :set! 195 | :doc "Node for a set! special-form expression" 196 | :keys [[:form "`(set! target val)`"] 197 | ^:children 198 | [:target "An AST node representing the target of the set! expression, must be :assignable?"] 199 | ^:children 200 | [:val "An AST node representing the new value for the target"]]} 201 | {:op :throw 202 | :doc "Node for a throw special-form statement" 203 | :keys [[:form "`(throw exception)`"] 204 | ^:children 205 | [:exception "An AST node representing the exception to throw"]]} 206 | {:op :try 207 | :doc "Node for a try special-form expression" 208 | :keys [[:form "`(try body* catch* finally?)`"] 209 | ^:children 210 | [:body "Synthetic :do AST node (with :body? `true`) representing the body of this try expression"] 211 | ^:children 212 | [:catches "A vector of :catch AST nodes representing the catch clauses of this try expression"] 213 | ^:optional ^:children 214 | [:finally "Synthetic :do AST node (with :body? `true`) representing the final clause of this try expression"]]} 215 | {:op :var 216 | :doc "Node for a var symbol" 217 | :keys [[:form "A symbol naming the var"] 218 | [:var "The var object this symbol refers to"] 219 | ^:optional 220 | [:assignable? "`true` if the Var is :dynamic"]]} 221 | {:op :vector 222 | :doc "Node for a vector literal with attached metadata and/or non literal elements" 223 | :keys [[:form "`[item*]`"] 224 | ^:children 225 | [:items "A vector of AST nodes representing the items of the vector"]]} 226 | {:op :with-meta 227 | :doc "Node for a non quoted collection literal or a fn expression with attached metadata" 228 | :keys [[:form "Non quoted collection literal or fn expression with attached metadata"] 229 | ^:children 230 | [:meta "An AST node representing the metadata of expression. The node will be either a :map node or a :const node with :type :map"] 231 | ^:children 232 | [:expr "The expression this metadata is attached to, :op is one of :vector, :map, :set or :fn"]]}]} 233 | -------------------------------------------------------------------------------- /spec/buildref.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | java -cp .:`lein cp` clojure.main < (str x) 8 | (replace #"`(.*?)`" "$1") 9 | (replace #":([a-zA-Z\?!\-]*)" ":$1"))) 10 | 11 | (defn build-children [children] 12 | (if (some #(:optional (meta %)) children) 13 | (let [[c & rest] children] 14 | (let [k (build-children rest) 15 | kc (mapv (fn [x] (cons c x)) k)] 16 | (if (:optional (meta c)) 17 | (into k kc) 18 | kc))) 19 | (if (seq children) 20 | [children] 21 | [[]]))) 22 | 23 | (defn children [keys] 24 | (when-let [children (seq (filter #(:children (meta %)) keys))] 25 | (mapv #(mapv first %) (build-children children)))) 26 | 27 | (def nodes 28 | (apply str (for [{:keys [op doc keys]} (:node-keys tej-ref) :let [op (name op)]] 29 | (str "
" 30 | "

" "#" op "

" 31 | "

" doc "

" 32 | "
" 33 | "
:op
:" op "
" 34 | (apply str (for [[k d :as f] keys] 35 | (str "
" k "
" 36 | "
" (if (:optional (meta f)) 37 | "optional ") (fix d) "
"))) 38 | (if-let [c (children keys)] 39 | (str "
:children
" 40 | (join ", " (mapv (fn [c] (str "" c "")) c)) "
")) 41 | "
" 42 | "
\n")))) 43 | 44 | (def nav 45 | (apply str (for [{op :op} (:node-keys tej-ref) :let [op (name op)]] 46 | (str "
  • " op "
    • \n")))) 47 | 48 | (def common 49 | (apply str (str "
    " 50 | "
    " 51 | (apply str (for [[k d :as f] (:all-keys tej-ref)] 52 | (str "
    " k "
    " 53 | "
    " (if (:optional (meta f)) 54 | "optional ") (fix d) "
    "))) 55 | "
    " 56 | "
    \n"))) 57 | 58 | (spit "quickref.html" 59 | (-> html 60 | (replace "{nav}" nav) 61 | (replace "{common}" common) 62 | (replace "{nodes}" nodes))) 63 | -------------------------------------------------------------------------------- /spec/quickref.html.tpl: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | tools.analyzer AST Quickref 6 | 94 | 95 | 96 | 102 |
    103 |

    tools.analyzer AST Quickref

    104 |

    Common AST fields

    105 | {common} 106 |

    Nodes reference

    107 | {nodes} 108 |
    109 | 110 | 111 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer 10 | "Analyzer for clojure code, host agnostic. 11 | 12 | Entry point: 13 | * analyze 14 | 15 | Platform implementers must provide dynamic bindings for: 16 | * macroexpand-1 17 | * parse 18 | * create-var 19 | * var? 20 | 21 | Setting up the global env is also required, see clojure.tools.analyzer.env 22 | 23 | See clojure.tools.analyzer.core-test for an example on how to setup the analyzer." 24 | (:refer-clojure :exclude [macroexpand-1 macroexpand var? record? boolean? update-keys update-vals]) 25 | (:require [clojure.tools.analyzer.utils :refer :all] 26 | [clojure.tools.analyzer.env :as env]) 27 | (:import (clojure.lang Symbol IPersistentVector IPersistentMap IPersistentSet ISeq IType IRecord))) 28 | 29 | (derive :ctx/return :ctx/expr) 30 | 31 | (defmulti -analyze-form (fn [form _] (class form))) 32 | 33 | (declare analyze-symbol 34 | analyze-vector 35 | analyze-map 36 | analyze-set 37 | analyze-seq 38 | analyze-const) 39 | 40 | (def ^:dynamic analyze-form 41 | "Like analyze, but does not mark the form with :top-level true" 42 | -analyze-form) 43 | 44 | (defmethod -analyze-form Symbol 45 | [form env] 46 | (analyze-symbol form env)) 47 | 48 | (defmethod -analyze-form IPersistentVector 49 | [form env] 50 | (analyze-vector form env)) 51 | 52 | (defmethod -analyze-form IPersistentMap 53 | [form env] 54 | (analyze-map form env)) 55 | 56 | (defmethod -analyze-form IPersistentSet 57 | [form env] 58 | (analyze-set form env)) 59 | 60 | (defmethod -analyze-form ISeq 61 | [form env] 62 | (if-let [form (seq form)] 63 | (analyze-seq form env) 64 | (analyze-const form env))) 65 | 66 | (defmethod -analyze-form IType 67 | [form env] 68 | (analyze-const form env :type)) 69 | 70 | (prefer-method -analyze-form IType IPersistentMap) 71 | (prefer-method -analyze-form IType IPersistentVector) 72 | (prefer-method -analyze-form IType IPersistentSet) 73 | (prefer-method -analyze-form IType ISeq) 74 | 75 | (defmethod -analyze-form IRecord 76 | [form env] 77 | (analyze-const form env :record)) 78 | 79 | (prefer-method -analyze-form IRecord IPersistentMap) 80 | (prefer-method -analyze-form IRecord IPersistentVector) 81 | (prefer-method -analyze-form IRecord IPersistentSet) 82 | (prefer-method -analyze-form IRecord ISeq) 83 | 84 | (defmethod -analyze-form :default 85 | [form env] 86 | (analyze-const form env)) 87 | 88 | (defn analyze 89 | "Given a form to analyze and an environment, a map containing: 90 | * :locals a map from binding symbol to AST of the binding value 91 | * :context a keyword describing the form's context from the :ctx/* hierarchy. 92 | ** :ctx/expr the form is an expression: its value is used 93 | ** :ctx/return the form is an expression in return position, derives :ctx/expr 94 | ** :ctx/statement the value of the form is not used 95 | * :ns a symbol representing the current namespace of the form to be 96 | analyzed 97 | 98 | returns an AST for that form. 99 | 100 | Every node in the AST is a map that is *guaranteed* to have the following keys: 101 | * :op a keyword describing the AST node 102 | * :form the form represented by the AST node 103 | * :env the environment map of the AST node 104 | 105 | Additionally if the AST node contains sub-nodes, it is guaranteed to have: 106 | * :children a vector of the keys of the AST node mapping to the sub-nodes, 107 | ordered, when that makes sense 108 | 109 | It is considered a node either the top-level node (marked with :top-level true) 110 | or a node that can be reached via :children; if a node contains a node-like 111 | map that is not reachable by :children, there's no guarantee that such a map 112 | will contain the guaranteed keys." 113 | 114 | [form env] 115 | (assoc (analyze-form form env) :top-level true)) 116 | 117 | (defn empty-env 118 | "Returns an empty env" 119 | [] 120 | {:context :ctx/expr 121 | :locals {} 122 | :ns 'user}) 123 | 124 | (defn analyze-in-env 125 | "Takes an env map and returns a function that analyzes a form in that env" 126 | [env] 127 | (fn [form] (analyze-form form env))) 128 | 129 | (def ^{:dynamic true 130 | :arglists '([form env]) 131 | :doc "If form represents a macro form, returns its expansion, 132 | else returns form."} 133 | macroexpand-1) 134 | 135 | (def ^{:dynamic true 136 | :arglists '([[op & args] env]) 137 | :doc "Multimethod that dispatches on op, should default to -parse"} 138 | parse) 139 | 140 | (def ^{:dynamic true 141 | :arglists '([sym env]) 142 | :doc "Creates a var for sym and returns it"} 143 | create-var) 144 | 145 | (def ^{:dynamic true 146 | :arglists '([obj]) 147 | :doc "Returns true if obj represent a var form as returned by create-var"} 148 | var?) 149 | 150 | ;; this node wraps non-quoted collections literals with metadata attached 151 | ;; to them, the metadata will be evaluated at run-time, not treated like a constant 152 | (defn wrapping-meta 153 | [{:keys [form env] :as expr}] 154 | (let [meta (meta form)] 155 | (if (and (obj? form) 156 | (seq meta)) 157 | {:op :with-meta 158 | :env env 159 | :form form 160 | :meta (analyze-form meta (ctx env :ctx/expr)) 161 | :expr (assoc-in expr [:env :context] :ctx/expr) 162 | :children [:meta :expr]} 163 | expr))) 164 | 165 | (defn analyze-const 166 | [form env & [type]] 167 | (let [type (or type (classify form))] 168 | (merge 169 | {:op :const 170 | :env env 171 | :type type 172 | :literal? true 173 | :val form 174 | :form form} 175 | (when-let [m (and (obj? form) 176 | (not-empty (meta form)))] 177 | {:meta (analyze-const m (ctx env :ctx/expr) :map) ;; metadata on a constant literal will not be evaluated at 178 | :children [:meta]})))) ;; runtime, this is also true for metadata on quoted collection literals 179 | 180 | (defn analyze-vector 181 | [form env] 182 | (let [items-env (ctx env :ctx/expr) 183 | items (mapv (analyze-in-env items-env) form)] 184 | (wrapping-meta 185 | {:op :vector 186 | :env env 187 | :items items 188 | :form form 189 | :children [:items]}))) 190 | 191 | (defn analyze-map 192 | [form env] 193 | (let [kv-env (ctx env :ctx/expr) 194 | [keys vals] (reduce-kv (fn [[keys vals] k v] 195 | [(conj keys k) (conj vals v)]) 196 | [[] []] form) 197 | ks (mapv (analyze-in-env kv-env) keys) 198 | vs (mapv (analyze-in-env kv-env) vals)] 199 | (wrapping-meta 200 | {:op :map 201 | :env env 202 | :keys ks 203 | :vals vs 204 | :form form 205 | :children [:keys :vals]}))) 206 | 207 | (defn analyze-set 208 | [form env] 209 | (let [items-env (ctx env :ctx/expr) 210 | items (mapv (analyze-in-env items-env) form)] 211 | (wrapping-meta 212 | {:op :set 213 | :env env 214 | :items items 215 | :form form 216 | :children [:items]}))) 217 | 218 | (def specials 219 | "Set of special forms common to every clojure variant" 220 | '#{do if new quote set! try var 221 | catch throw finally def . 222 | let* letfn* loop* recur fn*}) 223 | 224 | (defn macroexpand 225 | "Repeatedly calls macroexpand-1 on form until it no longer 226 | represents a macro form, then returns it." 227 | [form env] 228 | (loop [form form] 229 | (let [mform (macroexpand-1 form env)] 230 | (if (= mform form) 231 | mform 232 | (recur mform))))) 233 | 234 | (defn analyze-symbol 235 | [sym env] 236 | (let [mform (macroexpand-1 sym env)] ;; t.a.j/macroexpand-1 macroexpands Class/Field into (. Class Field) 237 | (if (= mform sym) 238 | (merge (if-let [{:keys [mutable children] :as local-binding} (-> env :locals sym)] ;; locals shadow globals 239 | (merge (dissoc local-binding :init) ;; avoids useless passes later 240 | {:op :local 241 | :assignable? (boolean mutable) 242 | :children (vec (remove #{:init} children))}) 243 | (if-let [var (let [v (resolve-sym sym env)] 244 | (and (var? v) v))] 245 | (let [m (meta var)] 246 | {:op :var 247 | :assignable? (dynamic? var m) ;; we cannot statically determine if a Var is in a thread-local context 248 | :var var ;; so checking whether it's dynamic or not is the most we can do 249 | :meta m}) 250 | (if-let [maybe-class (namespace sym)] ;; e.g. js/foo.bar or Long/MAX_VALUE 251 | (let [maybe-class (symbol maybe-class)] 252 | {:op :maybe-host-form 253 | :class maybe-class 254 | :field (symbol (name sym))}) 255 | {:op :maybe-class ;; e.g. java.lang.Integer or Long 256 | :class mform}))) 257 | {:env env 258 | :form mform}) 259 | (-> (analyze-form mform env) 260 | (update-in [:raw-forms] (fnil conj ()) sym))))) 261 | 262 | (defn analyze-seq 263 | [form env] 264 | (let [op (first form)] 265 | (when (nil? op) 266 | (throw (ex-info "Can't call nil" 267 | (merge {:form form} 268 | (-source-info form env))))) 269 | (let [mform (macroexpand-1 form env)] 270 | (if (= form mform) ;; function/special-form invocation 271 | (parse mform env) 272 | (-> (analyze-form mform env) 273 | (update-in [:raw-forms] (fnil conj ()) 274 | (vary-meta form assoc ::resolved-op (resolve-sym op env)))))))) 275 | 276 | (defn parse-do 277 | [[_ & exprs :as form] env] 278 | (let [statements-env (ctx env :ctx/statement) 279 | [statements ret] (loop [statements [] [e & exprs] exprs] 280 | (if (seq exprs) 281 | (recur (conj statements e) exprs) 282 | [statements e])) 283 | statements (mapv (analyze-in-env statements-env) statements) 284 | ret (analyze-form ret env)] 285 | {:op :do 286 | :env env 287 | :form form 288 | :statements statements 289 | :ret ret 290 | :children [:statements :ret]})) 291 | 292 | (defn parse-if 293 | [[_ test then else :as form] env] 294 | (let [formc (count form)] 295 | (when-not (or (= formc 3) (= formc 4)) 296 | (throw (ex-info (str "Wrong number of args to if, had: " (dec (count form))) 297 | (merge {:form form} 298 | (-source-info form env)))))) 299 | (let [test-expr (analyze-form test (ctx env :ctx/expr)) 300 | then-expr (analyze-form then env) 301 | else-expr (analyze-form else env)] 302 | {:op :if 303 | :form form 304 | :env env 305 | :test test-expr 306 | :then then-expr 307 | :else else-expr 308 | :children [:test :then :else]})) 309 | 310 | (defn parse-new 311 | [[_ class & args :as form] env] 312 | (when-not (>= (count form) 2) 313 | (throw (ex-info (str "Wrong number of args to new, had: " (dec (count form))) 314 | (merge {:form form} 315 | (-source-info form env))))) 316 | (let [args-env (ctx env :ctx/expr) 317 | args (mapv (analyze-in-env args-env) args)] 318 | {:op :new 319 | :env env 320 | :form form 321 | :class (analyze-form class (assoc env :locals {})) ;; avoid shadowing 322 | :args args 323 | :children [:class :args]})) 324 | 325 | (defn parse-quote 326 | [[_ expr :as form] env] 327 | (when-not (= 2 (count form)) 328 | (throw (ex-info (str "Wrong number of args to quote, had: " (dec (count form))) 329 | (merge {:form form} 330 | (-source-info form env))))) 331 | (let [const (analyze-const expr env)] 332 | {:op :quote 333 | :expr const 334 | :form form 335 | :env env 336 | :literal? true 337 | :children [:expr]})) 338 | 339 | (defn parse-set! 340 | [[_ target val :as form] env] 341 | (when-not (= 3 (count form)) 342 | (throw (ex-info (str "Wrong number of args to set!, had: " (dec (count form))) 343 | (merge {:form form} 344 | (-source-info form env))))) 345 | (let [target (analyze-form target (ctx env :ctx/expr)) 346 | val (analyze-form val (ctx env :ctx/expr))] 347 | {:op :set! 348 | :env env 349 | :form form 350 | :target target 351 | :val val 352 | :children [:target :val]})) 353 | 354 | (defn analyze-body [body env] 355 | ;; :body is used by emit-form to remove the artificial 'do 356 | (assoc (parse (cons 'do body) env) :body? true)) 357 | 358 | (defn valid-binding-symbol? [s] 359 | (and (symbol? s) 360 | (not (namespace s)) 361 | (not (re-find #"\." (name s))))) 362 | 363 | (defn ^:private split-with' [pred coll] 364 | (loop [take [] drop coll] 365 | (if (seq drop) 366 | (let [[el & r] drop] 367 | (if (pred el) 368 | (recur (conj take el) r) 369 | [(seq take) drop])) 370 | [(seq take) ()]))) 371 | 372 | (declare parse-catch) 373 | (defn parse-try 374 | [[_ & body :as form] env] 375 | (let [catch? (every-pred seq? #(= (first %) 'catch)) 376 | finally? (every-pred seq? #(= (first %) 'finally)) 377 | [body tail'] (split-with' (complement (some-fn catch? finally?)) body) 378 | [cblocks tail] (split-with' catch? tail') 379 | [[fblock & fbs :as fblocks] tail] (split-with' finally? tail)] 380 | (when-not (empty? tail) 381 | (throw (ex-info "Only catch or finally clause can follow catch in try expression" 382 | (merge {:expr tail 383 | :form form} 384 | (-source-info form env))))) 385 | (when-not (empty? fbs) 386 | (throw (ex-info "Only one finally clause allowed in try expression" 387 | (merge {:expr fblocks 388 | :form form} 389 | (-source-info form env))))) 390 | (let [env' (assoc env :in-try true) 391 | body (analyze-body body env') 392 | cenv (ctx env' :ctx/expr) 393 | cblocks (mapv #(parse-catch % cenv) cblocks) 394 | fblock (when-not (empty? fblock) 395 | (analyze-body (rest fblock) (ctx env :ctx/statement)))] 396 | (merge {:op :try 397 | :env env 398 | :form form 399 | :body body 400 | :catches cblocks} 401 | (when fblock 402 | {:finally fblock}) 403 | {:children (into [:body :catches] 404 | (when fblock [:finally]))})))) 405 | 406 | (defn parse-catch 407 | [[_ etype ename & body :as form] env] 408 | (when-not (valid-binding-symbol? ename) 409 | (throw (ex-info (str "Bad binding form: " ename) 410 | (merge {:sym ename 411 | :form form} 412 | (-source-info form env))))) 413 | (let [env (dissoc env :in-try) 414 | local {:op :binding 415 | :env env 416 | :form ename 417 | :name ename 418 | :local :catch}] 419 | {:op :catch 420 | :class (analyze-form etype (assoc env :locals {})) 421 | :local local 422 | :env env 423 | :form form 424 | :body (analyze-body body (assoc-in env [:locals ename] (dissoc-env local))) 425 | :children [:class :local :body]})) 426 | 427 | (defn parse-throw 428 | [[_ throw :as form] env] 429 | (when-not (= 2 (count form)) 430 | (throw (ex-info (str "Wrong number of args to throw, had: " (dec (count form))) 431 | (merge {:form form} 432 | (-source-info form env))))) 433 | {:op :throw 434 | :env env 435 | :form form 436 | :exception (analyze-form throw (ctx env :ctx/expr)) 437 | :children [:exception]}) 438 | 439 | (defn validate-bindings 440 | [[op bindings & _ :as form] env] 441 | (when-let [error-msg 442 | (cond 443 | (not (vector? bindings)) 444 | (str op " requires a vector for its bindings, had: " 445 | (class bindings)) 446 | 447 | (not (even? (count bindings))) 448 | (str op " requires an even number of forms in binding vector, had: " 449 | (count bindings)))] 450 | (throw (ex-info error-msg 451 | (merge {:form form 452 | :bindings bindings} 453 | (-source-info form env)))))) 454 | 455 | (defn parse-letfn* 456 | [[_ bindings & body :as form] env] 457 | (validate-bindings form env) 458 | (let [bindings (apply array-map bindings) ;; pick only one local with the same name, if more are present. 459 | fns (keys bindings)] 460 | (when-let [[sym] (seq (remove valid-binding-symbol? fns))] 461 | (throw (ex-info (str "Bad binding form: " sym) 462 | (merge {:form form 463 | :sym sym} 464 | (-source-info form env))))) 465 | (let [binds (reduce (fn [binds name] 466 | (assoc binds name 467 | {:op :binding 468 | :env env 469 | :name name 470 | :form name 471 | :local :letfn})) 472 | {} fns) 473 | e (update-in env [:locals] merge binds) ;; pre-seed locals 474 | binds (reduce-kv (fn [binds name bind] 475 | (assoc binds name 476 | (merge bind 477 | {:init (analyze-form (bindings name) 478 | (ctx e :ctx/expr)) 479 | :children [:init]}))) 480 | {} binds) 481 | e (update-in env [:locals] merge (update-vals binds dissoc-env)) 482 | body (analyze-body body e)] 483 | {:op :letfn 484 | :env env 485 | :form form 486 | :bindings (vec (vals binds)) ;; order is irrelevant 487 | :body body 488 | :children [:bindings :body]}))) 489 | 490 | (defn analyze-let 491 | [[op bindings & body :as form] {:keys [context loop-id] :as env}] 492 | (validate-bindings form env) 493 | (let [loop? (= 'loop* op)] 494 | (loop [bindings bindings 495 | env (ctx env :ctx/expr) 496 | binds []] 497 | (if-let [[name init & bindings] (seq bindings)] 498 | (if (not (valid-binding-symbol? name)) 499 | (throw (ex-info (str "Bad binding form: " name) 500 | (merge {:form form 501 | :sym name} 502 | (-source-info form env)))) 503 | (let [init-expr (analyze-form init env) 504 | bind-expr {:op :binding 505 | :env env 506 | :name name 507 | :init init-expr 508 | :form name 509 | :local (if loop? :loop :let) 510 | :children [:init]}] 511 | (recur bindings 512 | (assoc-in env [:locals name] (dissoc-env bind-expr)) 513 | (conj binds bind-expr)))) 514 | (let [body-env (assoc env :context (if loop? :ctx/return context)) 515 | body (analyze-body body (merge body-env 516 | (when loop? 517 | {:loop-id loop-id 518 | :loop-locals (count binds)})))] 519 | {:body body 520 | :bindings binds 521 | :children [:bindings :body]}))))) 522 | 523 | (defn parse-let* 524 | [form env] 525 | (into {:op :let 526 | :form form 527 | :env env} 528 | (analyze-let form env))) 529 | 530 | (defn parse-loop* 531 | [form env] 532 | (let [loop-id (gensym "loop_") ;; can be used to find matching recur 533 | env (assoc env :loop-id loop-id)] 534 | (into {:op :loop 535 | :form form 536 | :env env 537 | :loop-id loop-id} 538 | (analyze-let form env)))) 539 | 540 | (defn parse-recur 541 | [[_ & exprs :as form] {:keys [context loop-locals loop-id] 542 | :as env}] 543 | (when-let [error-msg 544 | (cond 545 | (not (isa? context :ctx/return)) 546 | "Can only recur from tail position" 547 | 548 | (not (= (count exprs) loop-locals)) 549 | (str "Mismatched argument count to recur, expected: " loop-locals 550 | " args, had: " (count exprs)))] 551 | (throw (ex-info error-msg 552 | (merge {:exprs exprs 553 | :form form} 554 | (-source-info form env))))) 555 | 556 | (let [exprs (mapv (analyze-in-env (ctx env :ctx/expr)) exprs)] 557 | {:op :recur 558 | :env env 559 | :form form 560 | :exprs exprs 561 | :loop-id loop-id 562 | :children [:exprs]})) 563 | 564 | (defn analyze-fn-method [[params & body :as form] {:keys [locals local] :as env}] 565 | (when-not (vector? params) 566 | (throw (ex-info "Parameter declaration should be a vector" 567 | (merge {:params params 568 | :form form} 569 | (-source-info form env) 570 | (-source-info params env))))) 571 | (when (not-every? valid-binding-symbol? params) 572 | (throw (ex-info (str "Params must be valid binding symbols, had: " 573 | (mapv class params)) 574 | (merge {:params params 575 | :form form} 576 | (-source-info form env) 577 | (-source-info params env))))) ;; more specific 578 | (let [variadic? (boolean (some '#{&} params)) 579 | params-names (if variadic? (conj (pop (pop params)) (peek params)) params) 580 | env (dissoc env :local) 581 | arity (count params-names) 582 | params-expr (mapv (fn [name id] 583 | {:env env 584 | :form name 585 | :name name 586 | :variadic? (and variadic? 587 | (= id (dec arity))) 588 | :op :binding 589 | :arg-id id 590 | :local :arg}) 591 | params-names (range)) 592 | fixed-arity (if variadic? 593 | (dec arity) 594 | arity) 595 | loop-id (gensym "loop_") 596 | body-env (into (update-in env [:locals] 597 | merge (zipmap params-names (map dissoc-env params-expr))) 598 | {:context :ctx/return 599 | :loop-id loop-id 600 | :loop-locals (count params-expr)}) 601 | body (analyze-body body body-env)] 602 | (when variadic? 603 | (let [x (drop-while #(not= % '&) params)] 604 | (when (contains? #{nil '&} (second x)) 605 | (throw (ex-info "Invalid parameter list" 606 | (merge {:params params 607 | :form form} 608 | (-source-info form env) 609 | (-source-info params env))))) 610 | (when (not= 2 (count x)) 611 | (throw (ex-info (str "Unexpected parameter: " (first (drop 2 x)) 612 | " after variadic parameter: " (second x)) 613 | (merge {:params params 614 | :form form} 615 | (-source-info form env) 616 | (-source-info params env))))))) 617 | (merge 618 | {:op :fn-method 619 | :form form 620 | :loop-id loop-id 621 | :env env 622 | :variadic? variadic? 623 | :params params-expr 624 | :fixed-arity fixed-arity 625 | :body body 626 | :children [:params :body]} 627 | (when local 628 | {:local (dissoc-env local)})))) 629 | 630 | (defn parse-fn* 631 | [[op & args :as form] env] 632 | (wrapping-meta 633 | (let [[n meths] (if (symbol? (first args)) 634 | [(first args) (next args)] 635 | [nil (seq args)]) 636 | name-expr {:op :binding 637 | :env env 638 | :form n 639 | :local :fn 640 | :name n} 641 | e (if n (assoc (assoc-in env [:locals n] (dissoc-env name-expr)) :local name-expr) env) 642 | once? (-> op meta :once boolean) 643 | menv (assoc (dissoc e :in-try) :once once?) 644 | meths (if (vector? (first meths)) (list meths) meths) ;;turn (fn [] ...) into (fn ([]...)) 645 | methods-exprs (mapv #(analyze-fn-method % menv) meths) 646 | variadic (seq (filter :variadic? methods-exprs)) 647 | variadic? (boolean variadic) 648 | fixed-arities (seq (map :fixed-arity (remove :variadic? methods-exprs))) 649 | max-fixed-arity (when fixed-arities (apply max fixed-arities))] 650 | (when (>= (count variadic) 2) 651 | (throw (ex-info "Can't have more than 1 variadic overload" 652 | (merge {:variadics (mapv :form variadic) 653 | :form form} 654 | (-source-info form env))))) 655 | (when (not= (seq (distinct fixed-arities)) fixed-arities) 656 | (throw (ex-info "Can't have 2 or more overloads with the same arity" 657 | (merge {:form form} 658 | (-source-info form env))))) 659 | (when (and variadic? 660 | (not-every? #(<= (:fixed-arity %) 661 | (:fixed-arity (first variadic))) 662 | (remove :variadic? methods-exprs))) 663 | (throw (ex-info "Can't have fixed arity overload with more params than variadic overload" 664 | (merge {:form form} 665 | (-source-info form env))))) 666 | (merge {:op :fn 667 | :env env 668 | :form form 669 | :variadic? variadic? 670 | :max-fixed-arity max-fixed-arity 671 | :methods methods-exprs 672 | :once once?} 673 | (when n 674 | {:local name-expr}) 675 | {:children (conj (if n [:local] []) :methods)})))) 676 | 677 | (defn parse-def 678 | [[_ sym & expr :as form] {:keys [ns] :as env}] 679 | (when (not (symbol? sym)) 680 | (throw (ex-info (str "First argument to def must be a symbol, had: " (class sym)) 681 | (merge {:form form} 682 | (-source-info form env))))) 683 | (when (and (namespace sym) 684 | (not= *ns* (the-ns (symbol (namespace sym))))) 685 | (throw (ex-info "Cannot def namespace qualified symbol" 686 | (merge {:form form 687 | :sym sym} 688 | (-source-info form env))))) 689 | (let [pfn (fn 690 | ([]) 691 | ([init] 692 | {:init init}) 693 | ([doc init] 694 | {:pre [(string? doc)]} 695 | {:init init :doc doc})) 696 | args (apply pfn expr) 697 | 698 | doc (or (:doc args) (-> sym meta :doc)) 699 | arglists (when-let [arglists (:arglists (meta sym))] 700 | (second arglists)) ;; drop quote 701 | 702 | sym (with-meta (symbol (name sym)) 703 | (merge (meta sym) 704 | (when arglists 705 | {:arglists arglists}) 706 | (when doc 707 | {:doc doc}) 708 | (-source-info form env))) 709 | 710 | var (create-var sym env) ;; interned var will have quoted arglists, replaced on evaluation 711 | _ (env/deref-env) ;; make sure *env* is bound 712 | _ (swap! env/*env* assoc-in [:namespaces ns :mappings sym] var) 713 | 714 | meta (merge (meta sym) 715 | (when arglists 716 | {:arglists (list 'quote arglists)})) 717 | 718 | meta-expr (when meta (analyze-form meta (ctx env :ctx/expr))) ;; meta on def sym will be evaluated 719 | 720 | args (when-let [[_ init] (find args :init)] 721 | (assoc args :init (analyze-form init (ctx env :ctx/expr)))) 722 | init? (:init args) 723 | children (into (into [] (when meta [:meta])) 724 | (when init? [:init]))] 725 | 726 | (merge {:op :def 727 | :env env 728 | :form form 729 | :name sym 730 | :var var} 731 | (when meta 732 | {:meta meta-expr}) 733 | args 734 | (when-not (empty? children) 735 | {:children children})))) 736 | 737 | (defn parse-dot 738 | [[_ target & [m-or-f & args] :as form] env] 739 | (when-not (>= (count form) 3) 740 | (throw (ex-info (str "Wrong number of args to ., had: " (dec (count form))) 741 | (merge {:form form} 742 | (-source-info form env))))) 743 | (let [[m-or-f field?] (if (and (symbol? m-or-f) 744 | (= \- (first (name m-or-f)))) 745 | [(-> m-or-f name (subs 1) symbol) true] 746 | [(if args (cons m-or-f args) m-or-f) false]) 747 | target-expr (analyze-form target (ctx env :ctx/expr)) 748 | call? (and (not field?) (seq? m-or-f))] 749 | 750 | (when (and call? (not (symbol? (first m-or-f)))) 751 | (throw (ex-info (str "Method name must be a symbol, had: " (class (first m-or-f))) 752 | (merge {:form form 753 | :method m-or-f} 754 | (-source-info form env))))) 755 | (merge {:form form 756 | :env env 757 | :target target-expr} 758 | (cond 759 | call? 760 | {:op :host-call 761 | :method (symbol (name (first m-or-f))) 762 | :args (mapv (analyze-in-env (ctx env :ctx/expr)) (next m-or-f)) 763 | :children [:target :args]} 764 | 765 | field? 766 | {:op :host-field 767 | :assignable? true 768 | :field (symbol (name m-or-f)) 769 | :children [:target]} 770 | 771 | :else 772 | {:op :host-interop ;; either field access or no-args method call 773 | :assignable? true 774 | :m-or-f (symbol (name m-or-f)) 775 | :children [:target]})))) 776 | 777 | (defn parse-invoke 778 | [[f & args :as form] env] 779 | (let [fenv (ctx env :ctx/expr) 780 | fn-expr (analyze-form f fenv) 781 | args-expr (mapv (analyze-in-env fenv) args) 782 | m (meta form)] 783 | (merge {:op :invoke 784 | :form form 785 | :env env 786 | :fn fn-expr 787 | :args args-expr} 788 | (when (seq m) 789 | {:meta m}) ;; meta on invoke form will not be evaluated 790 | {:children [:fn :args]}))) 791 | 792 | (defn parse-var 793 | [[_ var :as form] env] 794 | (when-not (= 2 (count form)) 795 | (throw (ex-info (str "Wrong number of args to var, had: " (dec (count form))) 796 | (merge {:form form} 797 | (-source-info form env))))) 798 | (if-let [var (resolve-sym var env)] 799 | {:op :the-var 800 | :env env 801 | :form form 802 | :var var} 803 | (throw (ex-info (str "var not found: " var) {:var var})))) 804 | 805 | (defn -parse 806 | "Takes a form and an env map and dispatches on the head of the form, that is 807 | a special form." 808 | [form env] 809 | ((case (first form) 810 | do parse-do 811 | if parse-if 812 | new parse-new 813 | quote parse-quote 814 | set! parse-set! 815 | try parse-try 816 | throw parse-throw 817 | def parse-def 818 | . parse-dot 819 | let* parse-let* 820 | letfn* parse-letfn* 821 | loop* parse-loop* 822 | recur parse-recur 823 | fn* parse-fn* 824 | var parse-var 825 | #_:else parse-invoke) 826 | form env)) 827 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/ast.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.ast 10 | "Utilities for AST walking/updating" 11 | (:refer-clojure :exclude [unreduced]) 12 | (:require [clojure.tools.analyzer.utils :refer [into! rseqv mapv']])) 13 | 14 | (defn cycling 15 | "Combine the given passes in a single pass that will be applied repeatedly 16 | to the AST until applying it another time will have no effect" 17 | [& fns*] 18 | (let [fns (cycle fns*)] 19 | (fn [ast] 20 | (loop [[f & fns] fns ast ast res (zipmap fns* (repeat nil))] 21 | (let [ast* (f ast)] 22 | (if (= ast* (res f)) 23 | ast 24 | (recur fns ast* (assoc res f ast*)))))))) 25 | 26 | (defn children* 27 | "Return a vector of vectors of the children node key and the children expression 28 | of the AST node, if it has any. 29 | The returned vector returns the children in the order as they appear in the 30 | :children field of the AST, and the children expressions may be either a node 31 | or a vector of nodes." 32 | [{:keys [children] :as ast}] 33 | (when children 34 | (mapv #(find ast %) children))) 35 | 36 | (defn children 37 | "Return a vector of the children expression of the AST node, if it has any. 38 | The children expressions are kept in order and flattened so that the returning 39 | vector contains only nodes and not vectors of nodes." 40 | [ast] 41 | (persistent! 42 | (reduce (fn [acc [_ c]] ((if (vector? c) into! conj!) acc c)) 43 | (transient []) (children* ast)))) 44 | 45 | ;; return transient or reduced holding transient 46 | (defn ^:private -update-children 47 | [ast f r?] 48 | (let [fix (if r? rseqv identity)] 49 | (reduce (fn [ast [k v]] 50 | (let [multi (vector? v) 51 | val (if multi (mapv' f (fix v)) (f v))] 52 | (if (reduced? val) 53 | (reduced (reduced (assoc! ast k (if multi (fix @val) @val)))) 54 | (assoc! ast k (if multi (fix val) val))))) 55 | (transient ast) 56 | (fix (children* ast))))) 57 | 58 | (defn update-children-reduced 59 | "Like update-children but returns a reduced holding the AST if f short-circuited." 60 | ([ast f] (update-children-reduced ast f false)) 61 | ([ast f reversed?] 62 | (if (and (not (reduced? ast)) 63 | (:children ast)) 64 | (let [ret (-update-children ast f reversed?)] 65 | (if (reduced? ret) 66 | (reduced (persistent! @ret)) 67 | (persistent! ret))) 68 | ast))) 69 | 70 | (defn ^:private unreduced [x] 71 | (if (reduced? x) 72 | @x 73 | x)) 74 | 75 | (defn update-children 76 | "Applies `f` to each AST children node, replacing it with the returned value. 77 | If reversed? is not-nil, `pre` and `post` will be applied starting from the last 78 | children of the AST node to the first one. 79 | Short-circuits on reduced." 80 | ([ast f] (update-children ast f false)) 81 | ([ast f reversed?] 82 | (unreduced (update-children-reduced ast f reversed?)))) 83 | 84 | (defn walk 85 | "Walk the ast applying `pre` when entering the nodes, and `post` when exiting. 86 | Both functions must return a valid node since the returned value will replace 87 | the node in the AST which was given as input to the function. 88 | If reversed? is not-nil, `pre` and `post` will be applied starting from the last 89 | children of the AST node to the first one. 90 | Short-circuits on reduced." 91 | ([ast pre post] 92 | (walk ast pre post false)) 93 | ([ast pre post reversed?] 94 | (unreduced 95 | ((fn walk [ast pre post reversed?] 96 | (let [walk #(walk % pre post reversed?)] 97 | (if (reduced? ast) 98 | ast 99 | (let [ret (update-children-reduced (pre ast) walk reversed?)] 100 | (if (reduced? ret) 101 | ret 102 | (post ret)))))) 103 | ast pre post reversed?)))) 104 | 105 | (defn prewalk 106 | "Shorthand for (walk ast f identity)" 107 | [ast f] 108 | (walk ast f identity)) 109 | 110 | (defn postwalk 111 | "Shorthand for (walk ast identity f reversed?)" 112 | ([ast f] 113 | (postwalk ast f false)) 114 | ([ast f reversed?] 115 | (walk ast identity f reversed?))) 116 | 117 | (defn nodes 118 | "Returns a lazy-seq of all the nodes in the given AST, in depth-first pre-order." 119 | [ast] 120 | (lazy-seq 121 | (cons ast (mapcat nodes (children ast))))) 122 | 123 | (defn ast->eav 124 | "Returns an EAV representation of the current AST that can be used by 125 | Datomic's Datalog." 126 | [ast] 127 | (let [children (set (:children ast))] 128 | (mapcat (fn [[k v]] 129 | (if (children k) 130 | (if (map? v) 131 | (into [[ast k v]] (ast->eav v)) 132 | (mapcat (fn [v] (into [[ast k v]] (ast->eav v))) v)) 133 | [[ast k v]])) ast))) 134 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/ast/query.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.ast.query 10 | "Utilities for querying tools.analyzer ASTs with Datomic" 11 | (:require [clojure.tools.analyzer.ast :as ast] 12 | [clojure.tools.analyzer.utils :refer [compile-if]])) 13 | 14 | (defn query-map 15 | "Transforms a Datomic query from its vector representation to its map one. 16 | If the given query is already in its map representation, the original query 17 | is returned." 18 | [query] 19 | (if (map? query) 20 | query 21 | (loop [ret {:find [] :in [] :where []} query query op nil] 22 | (if-let [[el & query] (seq query)] 23 | (if (keyword? el) 24 | (recur ret query el) 25 | (recur (update-in ret [op] conj el) query op)) 26 | (reduce-kv (fn [m k v] (if (seq v) (assoc m k v) m)) {} ret))))) 27 | 28 | (defn unfold-expression-clauses 29 | "Given a Datomic query, walk the :where clauses searching for 30 | expression clauses with nested calls, unnesting those calls. 31 | 32 | E.g {:where [[(inc (dec ?foo)) ?bar] ..] ..} will be transformed into 33 | {:where [[(dec ?foo) ?1234] [(inc ?1234) ?bar] ..] ..}" 34 | [query] 35 | (let [{:keys [where] :as query} (query-map query)] 36 | (if-not where 37 | query 38 | (assoc query :where 39 | (mapcat (fn [[op & rest :as form]] 40 | (if-let [[f & args] (and (seq? op) op)] 41 | (if (some seq? args) 42 | (loop [args args to-ssa {} cur [f] binds rest ret []] 43 | (if-let [[a & args] (seq args)] 44 | (if (and (seq? a) 45 | (not= 'quote (first a))) 46 | (let [g (gensym "?")] 47 | (recur args (assoc to-ssa g a) (conj cur g) binds ret)) 48 | (recur args to-ssa (conj cur a) binds ret)) 49 | (let [ret (conj ret (into [(seq cur)] binds))] 50 | (if-let [[k [f & args]] (first to-ssa)] 51 | (recur args (dissoc to-ssa k) [f] [k] ret) 52 | ret)))) 53 | [form]) 54 | [form])) where))))) 55 | 56 | (defn resolve-calls 57 | "Automatically replace fn name symbols in expression clauses with 58 | their namespace qualified one if the symbol can be resolved in the 59 | current namespace." 60 | [query] 61 | (let [{:keys [where] :as query} (query-map query)] 62 | (if-not where 63 | query 64 | (assoc query :where 65 | (mapv (fn [[op & rest :as form]] 66 | (if-let [[f & args] (and (seq? op) op)] 67 | (if-let [f-var (and (symbol? f) (resolve f))] 68 | (into [(seq (into [(symbol (str (ns-name (.ns f-var))) 69 | (str (.sym f-var)))] args))] 70 | rest) 71 | form) 72 | form)) where))))) 73 | 74 | (defn db 75 | "Given a list of ASTs, returns a representation of those 76 | that can be used as a database in a Datomic Datalog query." 77 | [asts] 78 | (mapcat ast/ast->eav asts)) 79 | 80 | (defn q 81 | "Execute a Datomic Datalog query against the ASTs. 82 | The first input is always assumed to be an AST database, if more 83 | are required, it's required to call `db` on them. 84 | `unfold-expression-clauses` is automatically applied to the 85 | query." 86 | [query asts & inputs] 87 | (compile-if (Class/forName "datomic.Datom") 88 | (do (require '[datomic.api :as d]) 89 | (apply (resolve 'datomic.api/q) (unfold-expression-clauses query) (db asts) inputs)) 90 | (throw (Exception. "Datomic is required")))) 91 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/env.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.env 10 | (:refer-clojure :exclude [ensure])) 11 | 12 | (def ^:dynamic *env* 13 | "Global env atom containing a map. 14 | Required options: 15 | * :namespaces a map from namespace symbol to namespace map, 16 | the namespace map contains at least the following keys: 17 | ** :mappings a map of mappings of the namespace, symbol to var/class 18 | ** :aliases a map of the aliases of the namespace, symbol to symbol 19 | ** :ns a symbol representing the namespace" 20 | nil) 21 | 22 | (defmacro with-env 23 | "Binds the global env to env, then executes the body" 24 | [env & body] 25 | `(let [env# ~env 26 | env# (cond 27 | (map? env#) (atom env#) 28 | (and (instance? clojure.lang.Atom env#) 29 | (map? @env#)) env# 30 | :default (throw (ex-info (str "global env must be a map or atom containing a map, not " 31 | (class env#)) 32 | {:env env#})))] 33 | (binding [*env* env#] ~@body))) 34 | 35 | ;; if *env* is not bound, bind it to env 36 | (defmacro ensure 37 | "If *env* is not bound it binds it to env before executing the body" 38 | [env & body] 39 | `(if *env* 40 | (do ~@body) 41 | (with-env ~env 42 | ~@body))) 43 | 44 | (defn deref-env 45 | "Returns the value of the current global env if bound, otherwise 46 | throws an exception." 47 | [] 48 | (if *env* 49 | @*env* 50 | (throw (Exception. "global env not bound")))) 51 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.analyzer.passes 2 | "Utilities for pass scheduling" 3 | (:refer-clojure :exclude [update-vals]) 4 | (:require [clojure.tools.analyzer.ast :refer [prewalk postwalk]] 5 | [clojure.tools.analyzer.utils :refer [update-vals]])) 6 | 7 | (defn ^:private has-deps? 8 | "Returns true if the pass has any dependencies" 9 | [pass] 10 | (seq (:dependencies pass))) 11 | 12 | (defn ^:private indicize 13 | "Takes a set of pass-infos and returns a map of pass-name -> pass-info" 14 | [passes] 15 | (zipmap (map :name passes) passes)) 16 | 17 | (defn ^:private remove-pass 18 | "Takes a set of pass-infos and a pass, and removes the pass from the set of 19 | pass-infos, updating :dependencies and :dependants as well." 20 | [passes pass] 21 | (indicize (reduce (fn [m p] (conj m (-> p (update-in [:dependencies] disj pass) 22 | (update-in [:dependants] disj pass)))) 23 | #{} (vals (dissoc passes pass))))) 24 | 25 | (defn desugar-deps 26 | "Takes a map of pass-name -> pass deps and puts the :after :affects and :before passes 27 | in the appropriate pass :depends" 28 | [passes] 29 | (reduce-kv (fn [m name {:keys [after affects before]}] 30 | (reduce (fn [m p] (update-in m [p :depends] (fnil conj #{}) name)) 31 | (update-in m [name :depends] (fnil into #{}) (into affects (filter passes after))) 32 | before)) passes passes)) 33 | 34 | (defn ^:private calc-deps 35 | "Takes a map of pass-name -> pass deps, a pass name, the explicit pass dependencies 36 | and a set of available pass-infos. 37 | Resolves all the transitive deps of the pass and assocs them to the map, indexed by 38 | the pass name." 39 | [m k deps passes] 40 | (if (m k) 41 | m 42 | (reduce (fn [m dep] 43 | (let [m (calc-deps m dep (get-in passes [dep :depends]) passes)] 44 | (update-in m [k] into (conj (or (m dep) #{}) dep)))) 45 | (assoc m k deps) deps))) 46 | 47 | (defn calculate-deps 48 | "Takes a map of pass-name -> pass-info and adds to each pass-info :dependencies and 49 | :dependants info, which also contains the transitive dependencies" 50 | [passes] 51 | (let [passes (desugar-deps passes) 52 | dependencies (reduce-kv (fn [deps pname {:keys [depends]}] 53 | (calc-deps deps pname depends passes)) 54 | {} passes) 55 | dependants (reduce-kv (fn [m k v] (reduce (fn [m v] (update-in m [v] (fnil conj #{}) k)) 56 | (update-in m [k] (fnil into #{}) nil) v)) 57 | {} dependencies)] 58 | (reduce-kv (fn [m k v] (assoc m k (merge (dissoc (passes k) :depends) 59 | {:dependencies (set v) :dependants (set (dependants k))}))) 60 | {} dependencies))) 61 | 62 | (defn group 63 | "Takes a scheduler state and returns a vector of three elements (or nil): 64 | * the :walk of the current group 65 | * a vector of consecutive passes that can be collapsed in a single pass (the current group) 66 | * the remaining scheduler state 67 | 68 | E.g. given: 69 | [{:walk :any ..} {:walk :pre ..} {:walk :post ..} {:walk :pre ..}] 70 | it will return: 71 | [:pre [{:walk :any ..} {:walk :pre ..}] [{:walk :post ..} {:walk :pre ..}]]" 72 | [state] 73 | (loop [w nil group [] [cur & rest :as state] state] 74 | (if (seq state) 75 | (cond 76 | (:affects (last group)) 77 | [w group state] 78 | 79 | w 80 | (if (#{w :any} (:walk cur)) 81 | (recur w (conj group cur) rest) 82 | [w group state]) 83 | 84 | :else 85 | (case (:walk cur) 86 | :any 87 | (recur nil (conj group cur) rest) 88 | :none 89 | [w group state] 90 | (recur (:walk cur) (conj group cur) rest))) 91 | [w group state]))) 92 | 93 | (defn satisfies-affected? [{:keys [affects walk]} passes] 94 | (loop [passes passes] 95 | (let [free (vals (filter (comp empty? :dependants val) passes))] 96 | (if-let [available-passes (seq (filter (comp #{walk :any} :walk) free))] 97 | (recur (reduce remove-pass passes (mapv :name available-passes))) 98 | (empty? (filter (fn [{:keys [name]}] ((set affects) name)) (vals passes))))))) 99 | 100 | (defn maybe-looping-pass [free passes] 101 | (if-let [looping (seq (filter :affects free))] 102 | (loop [[l & ls] looping] 103 | (if l 104 | (if (satisfies-affected? l (remove-pass passes (:name l))) 105 | ;; all deps satisfied 106 | l 107 | (recur ls)) 108 | (if-let [p (first (remove :affects free))] 109 | ;; pick a random avaliable non-looping pass 110 | p 111 | (throw (ex-info (str "looping pass doesn't encompass affected passes: " (:name l)) 112 | {:pass l}))))) 113 | ;; pick a random available pass 114 | (first free))) 115 | 116 | (def ^:private ffilter (comp first filter)) 117 | 118 | (defn ^:private first-walk [f c] 119 | (ffilter (comp #{f} :walk) c)) 120 | 121 | (defn schedule* [state passes] 122 | (let [free (filter (comp empty? :dependants) (vals passes)) 123 | w (first (group state)) 124 | non-looping-free (remove :affects free)] 125 | (if (seq passes) 126 | (let [{:keys [name] :as pass} (or (ffilter :compiler free) 127 | (and w (or (first-walk w non-looping-free) 128 | (first-walk :any non-looping-free))) 129 | (first-walk :none free) 130 | (maybe-looping-pass free passes))] 131 | (recur (cons (assoc pass :passes [name]) state) 132 | (remove-pass passes name))) 133 | state))) 134 | 135 | (defn collapse [state] 136 | (loop [[cur & rest :as state] state ret []] 137 | (if (seq state) 138 | (if (= :none (:walk cur)) 139 | (recur rest (conj ret cur)) 140 | (let [[w g state] (group state)] 141 | (recur state (conj ret {:walk (or w :pre) :passes (mapv :name g)})))) 142 | ret))) 143 | 144 | (defn schedule-passes 145 | [passes] 146 | (let [passes (calculate-deps passes)] 147 | 148 | (when (every? has-deps? (vals passes)) 149 | (throw (ex-info "Dependency cycle detected" passes))) 150 | 151 | (when (next (filter :compiler (vals passes))) 152 | (throw (ex-info "Only one compiler pass allowed" passes))) 153 | 154 | (collapse (schedule* () passes)))) 155 | 156 | (defn compile-passes [passes walk info] 157 | (let [with-state (filter (comp :state info) passes) 158 | state (zipmap with-state (mapv #(:state (info %)) with-state)) 159 | pfns (reduce (fn [f p] 160 | (let [i (info p) 161 | p (cond 162 | (:state i) 163 | (fn [_ s ast] (p (s p) ast)) 164 | (:affects i) 165 | (fn [a _ ast] ((p a) ast)) 166 | :else 167 | (fn [_ _ ast] (p ast)))] 168 | (fn [a s ast] 169 | (p a s (f a s ast))))) (fn [_ _ ast] ast) passes)] 170 | (fn analyze [ast] 171 | (walk ast (partial pfns analyze (update-vals state #(%))))))) 172 | 173 | (defn schedule 174 | "Takes a set of Vars that represent tools.analyzer passes and returns a function 175 | that takes an AST and applies all the passes and their dependencies to the AST, 176 | trying to compose together as many passes as possible to reduce the number of 177 | full tree traversals. 178 | 179 | Each pass must have a :pass-info element in its Var's metadata and it must point 180 | to a map with the following parameters (:before, :after, :affects and :state are 181 | optional): 182 | * :after a set of Vars, the passes that must be run before this pass 183 | * :before a set of Vars, the passes that must be run after this pass 184 | * :depends a set of Vars, the passes this pass depends on, implies :after 185 | * :walk a keyword, one of: 186 | - :none if the pass does its own tree walking and cannot be composed 187 | with other passes 188 | - :post if the pass requires a postwalk and can be composed with other 189 | passes 190 | - :pre if the pass requires a prewalk and can be composed with other 191 | passes 192 | - :any if the pass can be composed with other passes in both a prewalk 193 | or a postwalk 194 | * :affects a set of Vars, this pass must be the last in the same tree traversal that all 195 | the specified passes must participate in 196 | This pass must take a function as argument and return the actual pass, the 197 | argument represents the reified tree traversal which the pass can use to 198 | control a recursive traversal, implies :depends 199 | * :state a no-arg function that should return an atom holding an init value that will be 200 | passed as the first argument to the pass (the pass will thus take the ast 201 | as the second parameter), the atom will be the same for the whole tree traversal 202 | and thus can be used to preserve state across the traversal 203 | An opts map might be provided, valid parameters: 204 | * :debug? if true, returns a vector of the scheduled passes rather than the concrete 205 | function" 206 | [passes & [opts]] 207 | {:pre [(set? passes) 208 | (every? var? passes)]} 209 | (let [info (indicize (mapv (fn [p] (merge {:name p} (:pass-info (meta p)))) passes)) 210 | passes+deps (into passes (mapcat :depends (vals info)))] 211 | (if (not= passes passes+deps) 212 | (recur passes+deps [opts]) 213 | (if (:debug? opts) 214 | (mapv #(select-keys % [:passes :walk]) 215 | (schedule-passes info)) 216 | (reduce (fn [f {:keys [passes walk]}] 217 | (let [pass (if (= walk :none) 218 | (first passes) 219 | (compile-passes passes (if (= :pre walk) prewalk postwalk) info))] 220 | (comp pass f))) 221 | identity (schedule-passes info)))))) 222 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/add_binding_atom.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.add-binding-atom 10 | (:require [clojure.tools.analyzer.ast :refer [prewalk]] 11 | [clojure.tools.analyzer.passes.uniquify :refer [uniquify-locals]])) 12 | 13 | (defn add-binding-atom 14 | "Adds an atom-backed-map to every local binding,the same 15 | atom will be shared between all occurences of that local. 16 | 17 | The atom is put in the :atom field of the node." 18 | {:pass-info {:walk :pre :depends #{#'uniquify-locals} :state (fn [] (atom {}))}} 19 | ([ast] (prewalk ast (partial add-binding-atom (atom {})))) 20 | ([state ast] 21 | (case (:op ast) 22 | :binding 23 | (let [a (atom {})] 24 | (swap! state assoc (:name ast) a) 25 | (assoc ast :atom a)) 26 | :local 27 | (if-let [a (@state (:name ast))] 28 | (assoc ast :atom a) 29 | ;; handle injected locals 30 | (let [a (get-in ast [:env :locals (:name ast) :atom] (atom {}))] 31 | (swap! state assoc (:name ast) a) 32 | (assoc ast :atom a))) 33 | ast))) 34 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/cleanup.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.cleanup) 10 | 11 | (defn cleanup 12 | {:pass-info {:walk :any :depends #{}}} 13 | [ast] 14 | (-> ast 15 | (update-in [:env] dissoc :loop-locals-casts) 16 | (update-in [:env :locals] #(reduce-kv (fn [m k l] (assoc m k (dissoc l :env :init))) {} %)) 17 | (dissoc :atom))) 18 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/collect_closed_overs.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.collect-closed-overs 10 | (:require [clojure.tools.analyzer.ast :refer [update-children]] 11 | [clojure.tools.analyzer.env :as env] 12 | [clojure.tools.analyzer.passes.cleanup :refer [cleanup]] 13 | [clojure.tools.analyzer.passes.uniquify :refer [uniquify-locals]])) 14 | 15 | (def ^:private ^:dynamic *collects*) 16 | 17 | (declare collect-closed-overs*) 18 | (defn -collect-closed-overs 19 | [ast] 20 | (-> (case (:op ast) 21 | :letfn ;; seed letfn bindings 22 | (let [bindings (:bindings ast)] 23 | (doseq [{:keys [name]} bindings] 24 | (swap! *collects* #(update-in % [:locals] conj name))) 25 | ast) 26 | :binding 27 | (let [name (:name ast)] 28 | (if (= :field (:local ast)) 29 | (swap! *collects* #(assoc-in % [:closed-overs name] (cleanup ast))) ;; special-case: put directly as closed-overs 30 | (swap! *collects* #(update-in % [:locals] conj name))) ;; register the local as a frame-local locals 31 | ast) 32 | :local 33 | (let [name (:name ast)] 34 | (when-not ((:locals @*collects*) name) ;; if the local is not in the frame-local locals 35 | (swap! *collects* #(assoc-in % [:closed-overs name] (cleanup ast)))) ;; then it's from the outer frame locals, thus a closed-over 36 | ast) 37 | ast) 38 | (update-children collect-closed-overs*))) ;; recursively collect closed-overs in the children nodes 39 | 40 | (defn collect-closed-overs* 41 | [{:keys [op] :as ast}] 42 | (let [collects @*collects* 43 | collect? ((:where collects) op)] 44 | (if collect? 45 | (let [[ast {:keys [closed-overs locals]}] 46 | (binding [*collects* (atom (merge @*collects* 47 | {:closed-overs {} :locals #{}}))] 48 | [(update-children ast -collect-closed-overs) @*collects*])] 49 | (swap! *collects* #(update-in % [:closed-overs] merge ;; propagate closed-overs from the inner frame to the outer frame 50 | (into {} 51 | (remove (fn [[_ {:keys [local]}]] ;; remove deftype fields from the closed-over locals 52 | (and (= op :deftype) 53 | (= :field local))) 54 | (apply dissoc closed-overs ;; remove from the closed-overs locals that were 55 | (:locals @*collects*)))))) ;; local to the inner frame 56 | (assoc ast :closed-overs closed-overs)) 57 | (-collect-closed-overs ast)))) 58 | 59 | (defn collect-closed-overs 60 | "Attach closed-overs info to the AST as specified by the passes opts: 61 | * :where set of :op nodes where to attach the closed-overs 62 | * :top-level? if true attach closed-overs info to the top-level node 63 | 64 | The info will be attached in the :closed-overs field of the AST node 65 | and will be a map of local name -> binding AST node" 66 | {:pass-info {:walk :none :depends #{#'uniquify-locals}}} 67 | [ast] 68 | (let [passes-opts (:passes-opts (env/deref-env)) 69 | {:keys [top-level?] :as opts} {:where (or (:collect-closed-overs/where passes-opts) #{}) 70 | :top-level? (:collect-closed-overs/top-level? passes-opts)}] 71 | (binding [*collects* (atom (merge opts {:closed-overs {} :locals #{}}))] 72 | (let [ast (collect-closed-overs* ast)] 73 | (if top-level? 74 | (assoc ast :closed-overs (:closed-overs @*collects*)) 75 | ast))))) 76 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/constant_lifter.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.constant-lifter 10 | (:require [clojure.tools.analyzer.utils :refer [const-val]])) 11 | 12 | (defmulti constant-lift 13 | "If the node represents a collection with no metadata, and every item of that 14 | collection is a literal, transform the node to an equivalent :const node." 15 | {:pass-info {:walk :post :depends #{}}} 16 | :op) 17 | 18 | (defmethod constant-lift :vector 19 | [{:keys [items form env] :as ast}] 20 | (if (and (every? :literal? items) 21 | (empty? (meta form))) 22 | (merge (dissoc ast :items :children) 23 | {:op :const 24 | :val (mapv const-val items) 25 | :type :vector 26 | :literal? true}) 27 | ast)) 28 | 29 | (defmethod constant-lift :map 30 | [{:keys [keys vals form env] :as ast}] 31 | (if (and (every? :literal? keys) 32 | (every? :literal? vals) 33 | (empty? (meta form))) 34 | (let [c (into (empty form) 35 | (zipmap (mapv const-val keys) 36 | (mapv const-val vals))) 37 | c (if (= (class c) (class form)) 38 | c 39 | (apply array-map (mapcat identity c)))] 40 | (merge (dissoc ast :keys :vals :children) 41 | {:op :const 42 | :val c 43 | :type :map 44 | :literal? true})) 45 | ast)) 46 | 47 | (defmethod constant-lift :set 48 | [{:keys [items form env] :as ast}] 49 | (if (and (every? :literal? items) 50 | (empty? (meta form))) 51 | (merge (dissoc ast :items :children) 52 | {:op :const 53 | :val (into (empty form) (mapv const-val items)) 54 | :type :set 55 | :literal? true}) 56 | ast)) 57 | 58 | (defmethod constant-lift :default [ast] ast) 59 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/elide_meta.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.elide-meta 10 | (:require [clojure.tools.analyzer.passes.source-info :refer [source-info]])) 11 | 12 | (def ^:dynamic elides 13 | "A map of op keywords to predicate IFns. 14 | The predicate will be used to indicate what map keys should be elided on 15 | metadata of nodes for that op. 16 | :all can be used to indicate what should be elided for every node with 17 | metadata. 18 | Defaults to {:all (set (:elide-meta *compiler-options*))}" 19 | {:all (set (:elide-meta *compiler-options*))}) 20 | 21 | (defn replace-meta [meta new-meta] 22 | (if (= :const (:op meta)) 23 | (assoc meta :val new-meta) 24 | (let [meta-map (mapv (fn [k v] 25 | (when-not (elides (:form k)) 26 | [k v])) 27 | (:keys meta) (:vals meta))] 28 | (assoc meta 29 | :keys (vec (keep first meta-map)) 30 | :vals (vec (keep second meta-map)))))) 31 | 32 | (defn get-elides [{:keys [op expr type]}] 33 | (let [k (case op 34 | :with-meta 35 | (:op expr) 36 | 37 | :const 38 | type 39 | 40 | nil) 41 | f (get elides k)] 42 | (if f 43 | (some-fn (:all elides) f) 44 | (:all elides)))) 45 | 46 | (defn -elide-meta 47 | [{:keys [op meta expr env] :as ast}] 48 | (let [form (:form meta) 49 | new-meta (apply dissoc form (filter (get-elides ast) (keys form)))] 50 | (case op 51 | :const 52 | (if (or (not meta) 53 | (= new-meta (:form meta))) 54 | ast 55 | (if (not (empty? new-meta)) 56 | (assoc-in ast [:meta :val] new-meta) 57 | (-> ast 58 | (update-in [:val] with-meta nil) 59 | (dissoc :children :meta)))) 60 | :with-meta 61 | (if (not (empty? new-meta)) 62 | (if (= new-meta (:form meta)) 63 | ast 64 | (assoc ast :meta (replace-meta meta new-meta))) 65 | (merge (dissoc ast :meta :expr) 66 | {:op :do 67 | :body? true 68 | :ret expr 69 | :statements [] 70 | :children [:statements :ret]})) 71 | :def 72 | (if (not (empty? new-meta)) 73 | (if (= new-meta (:form meta)) 74 | ast 75 | (assoc ast :meta (replace-meta meta new-meta))) 76 | (let [ast (dissoc ast :meta)] 77 | (if-let [new-children (not-empty (filterv (complement #{:meta}) (:children ast)))] 78 | (assoc ast :children new-children) 79 | (dissoc ast :children)))) 80 | ast))) 81 | 82 | (defn elide-meta 83 | "If elides is not empty and the AST node contains metadata, 84 | dissoc all the keys in elides from the metadata." 85 | {:pass-info {:walk :any :depends #{} :after #{#'source-info}}} 86 | [ast] 87 | (if (some #(if (seq? %) (seq %) %) (vals elides)) 88 | (-elide-meta ast) 89 | ast)) 90 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/emit_form.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.emit-form 10 | (:require [clojure.tools.analyzer.passes.uniquify :refer [uniquify-locals]])) 11 | 12 | (defmulti -emit-form (fn [{:keys [op]} _] op)) 13 | 14 | (defn ^:dynamic -emit-form* 15 | "Extension point for custom emit-form implementations, should be rebound 16 | to a multimethod with custom emit-form :opts." 17 | [{:keys [form] :as ast} opts] 18 | (let [expr (-emit-form ast opts)] 19 | (if-let [m (and (instance? clojure.lang.IObj expr) 20 | (meta form))] 21 | (with-meta expr (merge m (meta expr))) 22 | expr))) 23 | 24 | (defn emit-form 25 | "Return the form represented by the given AST. 26 | Opts is a set of options, valid options are: 27 | * :hygienic" 28 | {:pass-info {:walk :none :depends #{#'uniquify-locals} :compiler true}} 29 | ([ast] (emit-form ast #{})) 30 | ([ast opts] (-emit-form* ast opts))) 31 | 32 | (defn emit-hygienic-form 33 | "Return an hygienic form represented by the given AST" 34 | {:pass-info {:walk :none :depends #{#'uniquify-locals} :compiler true}} 35 | [ast] 36 | (-emit-form* ast #{:hygienic})) 37 | 38 | (defmethod -emit-form :maybe-class 39 | [{:keys [class]} opts] 40 | class) 41 | 42 | (defmethod -emit-form :maybe-host-form 43 | [{:keys [class field]} opts] 44 | (symbol (name class) (name field))) 45 | 46 | (defmethod -emit-form :host-call 47 | [{:keys [target method args]} opts] 48 | (list '. (-emit-form* target opts) 49 | (list* method (mapv #(-emit-form* % opts) args)))) 50 | 51 | (defmethod -emit-form :host-field 52 | [{:keys [target field]} opts] 53 | (list '. (-emit-form* target opts) 54 | (symbol (str "-" (name field))))) 55 | 56 | (defmethod -emit-form :host-interop 57 | [{:keys [target m-or-f]} opts] 58 | (list '. (-emit-form* target opts) m-or-f)) 59 | 60 | (defmethod -emit-form :local 61 | [{:keys [name form]} opts] 62 | (if (:hygienic opts) (with-meta name (meta form)) form)) 63 | 64 | (defmethod -emit-form :binding 65 | [{:keys [name form]} opts] 66 | (if (:hygienic opts) (with-meta name (meta form)) form)) 67 | 68 | (defmethod -emit-form :var 69 | [{:keys [form]} opts] 70 | form) 71 | 72 | (defn emit-bindings [bindings opts] 73 | (mapcat (fn [{:keys [name form init]}] 74 | [(if (:hygienic opts) name form) (-emit-form* init opts)]) 75 | bindings)) 76 | 77 | (defmethod -emit-form :letfn 78 | [{:keys [bindings body]} opts] 79 | `(letfn* [~@(emit-bindings bindings opts)] 80 | ~(-emit-form* body opts))) 81 | 82 | (defmethod -emit-form :let 83 | [{:keys [bindings body]} opts] 84 | `(let* [~@(emit-bindings bindings opts)] 85 | ~(-emit-form* body opts))) 86 | 87 | (defmethod -emit-form :loop 88 | [{:keys [bindings body]} opts] 89 | `(loop* [~@(emit-bindings bindings opts)] 90 | ~(-emit-form* body opts))) 91 | 92 | (defmethod -emit-form :const 93 | [{:keys [form]} _] 94 | form) 95 | 96 | (defmethod -emit-form :quote 97 | [{:keys [expr]} opts] 98 | (list 'quote (-emit-form* expr opts))) 99 | 100 | (defmethod -emit-form :vector 101 | [{:keys [items]} opts] 102 | (mapv #(-emit-form* % opts) items)) 103 | 104 | (defmethod -emit-form :set 105 | [{:keys [items]} opts] 106 | (set (mapv #(-emit-form* % opts) items))) 107 | 108 | (defmethod -emit-form :map 109 | [{:keys [keys vals]} opts] 110 | (apply hash-map (interleave (mapv #(-emit-form* % opts) keys) 111 | (mapv #(-emit-form* % opts) vals)))) 112 | 113 | (defmethod -emit-form :with-meta 114 | [{:keys [expr meta]} opts] 115 | (with-meta (-emit-form* expr opts) 116 | (-emit-form* meta opts))) 117 | 118 | (defmethod -emit-form :do 119 | [{:keys [ret statements body?]} opts] 120 | (if (and body? (empty? statements)) 121 | (-emit-form* ret opts) 122 | `(do ~@(mapv #(-emit-form* % opts) statements) 123 | ~(-emit-form* ret opts)))) 124 | 125 | (defmethod -emit-form :if 126 | [{:keys [test then else]} opts] 127 | `(if ~(-emit-form* test opts) 128 | ~(-emit-form* then opts) 129 | ~@(when-not (nil? (:form else)) 130 | [(-emit-form* else opts)]))) 131 | 132 | (defmethod -emit-form :new 133 | [{:keys [class args]} opts] 134 | `(new ~(-emit-form* class opts) ~@(mapv #(-emit-form* % opts) args))) 135 | 136 | (defmethod -emit-form :set! 137 | [{:keys [target val]} opts] 138 | `(set! ~(-emit-form* target opts) ~(-emit-form* val opts))) 139 | 140 | (defmethod -emit-form :recur 141 | [{:keys [exprs]} opts] 142 | `(recur ~@(mapv #(-emit-form* % opts) exprs))) 143 | 144 | (defmethod -emit-form :fn-method 145 | [{:keys [variadic? params body form]} opts] 146 | (let [params-form (mapv #(-emit-form* % opts) params)] 147 | `(~(with-meta 148 | (if variadic? (into (pop params-form) 149 | (conj '[&] (peek params-form))) 150 | params-form) 151 | (meta (first form))) 152 | ~(-emit-form* body opts)))) 153 | 154 | (defmethod -emit-form :fn 155 | [{:keys [local methods]} opts] 156 | `(fn* ~@(when local [(-emit-form* local opts)]) 157 | ~@(mapv #(-emit-form* % opts) methods))) 158 | 159 | (defmethod -emit-form :def 160 | [{:keys [name doc init]} opts] 161 | (let [name (if-let [arglists (:arglists (meta name))] 162 | (with-meta name (assoc (meta name) :arglists (list 'quote arglists))) 163 | name)] 164 | `(def ~name ~@(when doc [doc]) ~@(when init [(-emit-form* init opts)])))) 165 | 166 | (defmethod -emit-form :invoke 167 | [{:keys [fn args meta]} opts] 168 | (let [expr `(~(-emit-form* fn opts) 169 | ~@(mapv #(-emit-form* % opts) args))] 170 | (if meta 171 | (with-meta expr meta) 172 | expr))) 173 | 174 | (defmethod -emit-form :try 175 | [{:keys [body catches finally]} opts] 176 | `(try ~(-emit-form* body opts) 177 | ~@(mapv #(-emit-form* % opts) catches) 178 | ~@(when finally 179 | [`(finally ~(-emit-form* finally opts))]))) 180 | 181 | (defmethod -emit-form :catch 182 | [{:keys [class local body]} opts] 183 | `(catch ~(-emit-form* class opts) ~(-emit-form* local opts) 184 | ~(-emit-form* body opts))) 185 | 186 | (defmethod -emit-form :throw 187 | [{:keys [exception]} opts] 188 | `(throw ~(-emit-form* exception opts))) 189 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/index_vector_nodes.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.index-vector-nodes) 10 | 11 | (defn index-vector-nodes 12 | "Adds an :idx attribute to nodes in a vector children, representing the position 13 | of the node vector." 14 | {:pass-info {:walk :any :depends #{}}} 15 | [ast] 16 | (merge ast 17 | (reduce (fn [m c] 18 | (let [v (c ast) 19 | v (if (vector? v) 20 | (mapv (fn [x i] (assoc x :idx i )) 21 | v (range)) 22 | v)] 23 | (assoc m c v))) {} (:children ast)))) 24 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/source_info.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.source-info 10 | (:require [clojure.tools.analyzer.utils :refer [-source-info merge']] 11 | [clojure.tools.analyzer.ast :refer [update-children]])) 12 | 13 | (defn -merge-source-info [source-info] 14 | (fn [ast] 15 | (update-in ast [:env] merge' source-info))) 16 | 17 | (defn source-info 18 | "Adds (when avaliable) :line, :column, :end-line, :end-column and :file info to the AST :env" 19 | {:pass-info {:walk :pre :depends #{}}} 20 | [ast] 21 | (let [source-info (-source-info (:form ast) (:env ast)) 22 | merge-source-info (-merge-source-info source-info)] 23 | (update-children (merge-source-info ast) merge-source-info))) 24 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/trim.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.trim 10 | (:require [clojure.tools.analyzer.passes.elide-meta :refer [elide-meta]] 11 | [clojure.tools.analyzer.ast :refer [postwalk]])) 12 | 13 | (defmulti -trim :op) 14 | 15 | (defmethod -trim :default [ast] ast) 16 | 17 | (defn preserving-raw-forms [{:keys [form raw-forms] :as ast} body] 18 | (let [raw-forms (reverse (cons form raw-forms))] 19 | (update-in (into ast body) [:raw-forms] into raw-forms))) 20 | 21 | (defmethod -trim :do 22 | [{:keys [statements ret form] :as ast}] 23 | (if (and (every? :literal? statements) 24 | (not (:tag (meta form)))) 25 | (preserving-raw-forms (dissoc ast :children :statements :ret) ret) 26 | ast)) 27 | 28 | ;;TODO: letfn/loop 29 | (defmethod -trim :let 30 | [{:keys [bindings body form] :as ast}] 31 | (if (and (or (and (every? (comp :literal? :init) bindings) 32 | (:literal? body)) 33 | (empty? bindings)) 34 | (not (:tag (meta form)))) 35 | (preserving-raw-forms (dissoc ast :children :bindings :body) body) 36 | ast)) 37 | 38 | (defmethod -trim :try 39 | [{:keys [catches finally body form] :as ast}] 40 | (if (and (empty? catches) 41 | (empty? finally) 42 | (not (:tag (meta form)))) 43 | (preserving-raw-forms (dissoc ast :children :body :finally :catches) body) 44 | ast)) 45 | 46 | (defn trim 47 | "Trims the AST of unnecessary nodes, e.g. (do (do 1)) -> 1" 48 | {:pass-info {:walk :none :depends #{} :after #{#'elide-meta}}} 49 | [ast] 50 | (postwalk ast -trim)) 51 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/uniquify.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.uniquify 10 | (:refer-clojure :exclude [update-vals]) 11 | (:require [clojure.tools.analyzer.ast :refer [update-children children]] 12 | [clojure.tools.analyzer.utils :refer [update-vals]] 13 | [clojure.tools.analyzer.env :as env])) 14 | 15 | (def ^:dynamic *locals-counter*) ;; global counter, map sym -> count 16 | (def ^:dynamic *locals-frame*) ;; holds the id for the locals in the current frame 17 | 18 | (defn normalize [name] 19 | (or (@*locals-frame* name) name)) 20 | 21 | (defn uniquify [name] 22 | (swap! *locals-counter* #(update-in % [name] (fnil inc -1))) 23 | (swap! *locals-frame* #(assoc-in % [name] (symbol (str name "__#" (@*locals-counter* name)))))) 24 | 25 | (defmulti -uniquify-locals :op) 26 | 27 | (defn uniquify-locals-around 28 | [ast] 29 | (let [ast (if (-> (env/deref-env) :passes-opts :uniquify/uniquify-env) 30 | (update-in ast [:env :locals] 31 | update-vals #(update-in % [:name] normalize)) 32 | ast)] 33 | (-uniquify-locals ast))) 34 | 35 | (defn uniquify-locals* [ast] 36 | (update-children ast uniquify-locals-around)) 37 | 38 | (defmethod -uniquify-locals :local 39 | [ast] 40 | (if (= :field (:local ast)) ;; deftype fields cannot be uniquified 41 | ast ;; to allow field access/set! to work 42 | (let [name (normalize (:name ast))] 43 | (assoc ast :name name)))) 44 | 45 | (defn uniquify-binding 46 | [b] 47 | (let [i (binding [*locals-frame* (atom @*locals-frame*)] ;; inits need to be uniquified before the local 48 | (uniquify-locals-around (:init b))) ;; to avoid potential shadowings 49 | name (:name b)] 50 | (uniquify name) 51 | (let [name (normalize name)] 52 | (assoc b 53 | :name name 54 | :init i)))) 55 | 56 | (defmethod -uniquify-locals :letfn 57 | [ast] 58 | (doseq [{:keys [name]} (:bindings ast)] ;; take into account that letfn 59 | (uniquify name)) ;; accepts parallel bindings 60 | (uniquify-locals* ast)) 61 | 62 | (defmethod -uniquify-locals :binding 63 | [{:keys [name local] :as ast}] 64 | (case local 65 | (:let :loop) 66 | (uniquify-binding ast) 67 | 68 | :letfn 69 | (-> ast 70 | (assoc :name (normalize name)) 71 | uniquify-locals*) 72 | 73 | :field 74 | ast 75 | 76 | (do (uniquify name) 77 | (assoc ast :name (normalize name))))) 78 | 79 | (defmethod -uniquify-locals :default 80 | [ast] 81 | (if (some #(= :binding (:op %)) (children ast)) 82 | (binding [*locals-frame* (atom @*locals-frame*)] ;; set up frame so locals won't leak 83 | (uniquify-locals* ast)) 84 | (uniquify-locals* ast))) 85 | 86 | (defn uniquify-locals 87 | "Walks the AST performing alpha-conversion on the :name field 88 | of :local/:binding nodes, invalidates :local map in :env field 89 | 90 | Passes opts: 91 | * :uniquify/uniquify-env If true, uniquifies the :env :locals map" 92 | {:pass-info {:walk :none :depends #{}}} 93 | [ast] 94 | (binding [*locals-counter* (atom {}) 95 | *locals-frame* (atom {})] 96 | (uniquify-locals-around ast))) 97 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/passes/warn_earmuff.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.passes.warn-earmuff 10 | (:require [clojure.tools.analyzer.utils :refer [dynamic?]])) 11 | 12 | (defn warn-earmuff 13 | "Prints a warning to *err* if the AST node is a :def node and the 14 | var name contains earmuffs but the var is not marked dynamic" 15 | {:pass-info {:walk :pre :depends #{}}} 16 | [ast] 17 | (let [name (str (:name ast))] 18 | (when (and (= :def (:op ast)) 19 | (> (count name) 2) ;; Allow * and ** as non-dynamic names 20 | (= (nth name 0) \*) 21 | (= (nth name (dec (count name))) \*) 22 | (not (dynamic? (:var ast) (:val (:meta ast))))) 23 | (binding [*out* *err*] 24 | (println "Warning:" name "not declared dynamic and thus is not dynamically rebindable," 25 | "but its name suggests otherwise." 26 | "Please either indicate ^:dynamic" name "or change the name")))) 27 | ast) 28 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/analyzer/utils.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.tools.analyzer.utils 10 | (:refer-clojure :exclude [record? boolean? update-keys update-vals]) 11 | (:require [clojure.tools.analyzer.env :as env]) 12 | (:import (clojure.lang IRecord IType IObj 13 | IReference Var))) 14 | 15 | (defn into! 16 | "Like into, but for transients" 17 | [to from] 18 | (reduce conj! to from)) 19 | 20 | (defn rseqv 21 | "Same as (comp vec rseq)" 22 | [v] 23 | (vec (rseq v))) 24 | 25 | (defn ctx 26 | "Returns a copy of the passed environment with :context set to ctx" 27 | [env ctx] 28 | (assoc env :context ctx)) 29 | 30 | (defn dissoc-env 31 | "Dissocs :env from the ast" 32 | [ast] 33 | (dissoc ast :env)) 34 | 35 | (defn butlast+last 36 | "Returns same value as (juxt butlast last), but slightly more 37 | efficient since it only traverses the input sequence s once, not 38 | twice." 39 | [s] 40 | (loop [butlast (transient []) 41 | s s] 42 | (if-let [xs (next s)] 43 | (recur (conj! butlast (first s)) xs) 44 | [(seq (persistent! butlast)) (first s)]))) 45 | 46 | (defn update-vals 47 | "Applies f to all the vals in the map" 48 | [m f] 49 | (reduce-kv (fn [m k v] (assoc m k (f v))) {} (or m {}))) 50 | 51 | (defn update-keys 52 | "Applies f to all the keys in the map" 53 | [m f] 54 | (reduce-kv (fn [m k v] (assoc m (f k) v)) {} (or m {}))) 55 | 56 | (defn update-kv 57 | "Applies f to all the keys and vals in the map" 58 | [m f] 59 | (reduce-kv (fn [m k v] (assoc m (f k) (f v))) {} (or m {}))) 60 | 61 | (defn record? 62 | "Returns true if x is a record" 63 | [x] 64 | (instance? IRecord x)) 65 | 66 | (defn type? 67 | "Returns true if x is a type" 68 | [x] 69 | (instance? IType x)) 70 | 71 | (defn obj? 72 | "Returns true if x implements IObj" 73 | [x] 74 | (instance? IObj x)) 75 | 76 | (defn reference? 77 | "Returns true if x implements IReference" 78 | [x] 79 | (instance? IReference x)) 80 | 81 | (defmacro compile-if 82 | [exp then & else] 83 | (if (try (eval exp) 84 | (catch Exception _ false)) 85 | `(do ~then) 86 | `(do ~@else))) 87 | 88 | (defn regex? 89 | "Returns true if x is a regex" 90 | [x] 91 | (instance? (compile-if (Class/forName "java.util.regex.Pattern") 92 | java.util.regex.Pattern 93 | System.Text.RegularExpressions.Regex) 94 | x)) 95 | 96 | (defn boolean? 97 | "Returns true if x is a boolean" 98 | [x] 99 | (or (true? x) (false? x))) 100 | 101 | (defn classify 102 | "Returns a keyword describing the form type" 103 | [form] 104 | (cond 105 | (nil? form) :nil 106 | (boolean? form) :bool 107 | (keyword? form) :keyword 108 | (symbol? form) :symbol 109 | (string? form) :string 110 | (number? form) :number 111 | (type? form) :type 112 | (record? form) :record 113 | (map? form) :map 114 | (vector? form) :vector 115 | (set? form) :set 116 | (seq? form) :seq 117 | (char? form) :char 118 | (regex? form) :regex 119 | (class? form) :class 120 | (var? form) :var 121 | :else :unknown)) 122 | 123 | (defn private? 124 | "Returns true if the var is private" 125 | ([var] (private? var nil)) 126 | ([var m] 127 | (:private (or m (meta var))))) 128 | 129 | (defn macro? 130 | "Returns true if the var maps to a macro" 131 | ([var] (macro? var nil)) 132 | ([var m] 133 | (:macro (or m (meta var))))) 134 | 135 | (defn constant? 136 | "Returns true if the var is a const" 137 | ([var] (constant? var nil)) 138 | ([var m] 139 | (:const (or m (meta var))))) 140 | 141 | (defn dynamic? 142 | "Returns true if the var is dynamic" 143 | ([var] (dynamic? var nil)) 144 | ([var m] 145 | (or (:dynamic (or m (meta var))) 146 | (when (var? var) ;; workaround needed since Clojure doesn't always propagate :dynamic 147 | (.isDynamic ^Var var))))) 148 | 149 | (defn protocol-node? 150 | "Returns true if the var maps to a protocol function" 151 | ([var] (protocol-node? var nil)) 152 | ([var m] 153 | (boolean (:protocol (or m (meta var)))))) ;; conveniently this is true in both clojure and clojurescript 154 | 155 | (defn resolve-ns 156 | "Resolves the ns mapped by the given sym in the global env" 157 | [ns-sym {:keys [ns]}] 158 | (when ns-sym 159 | (let [namespaces (:namespaces (env/deref-env))] 160 | (or (get-in namespaces [ns :aliases ns-sym]) 161 | (:ns (namespaces ns-sym)))))) 162 | 163 | (defn resolve-sym 164 | "Resolves the value mapped by the given sym in the global env" 165 | [sym {:keys [ns] :as env}] 166 | (when (symbol? sym) 167 | (let [sym-ns (when-let [ns (namespace sym)] 168 | (symbol ns)) 169 | full-ns (resolve-ns sym-ns env)] 170 | (when (or (not sym-ns) full-ns) 171 | (let [name (if sym-ns (-> sym name symbol) sym)] 172 | (-> (env/deref-env) :namespaces (get (or full-ns ns)) :mappings (get name))))))) 173 | 174 | (defn arglist-for-arity 175 | "Takes a fn node and an argc and returns the matching arglist" 176 | [fn argc] 177 | (let [arglists (->> fn :arglists (sort-by count)) 178 | arglist (->> arglists (filter #(= argc (count %))) first) 179 | last-arglist (last arglists)] 180 | (or arglist 181 | (when (and (some '#{&} last-arglist) 182 | (>= argc (- (count last-arglist) 2))) 183 | last-arglist)))) 184 | 185 | (defn select-keys' 186 | "Like clojure.core/select-keys, but uses transients and doesn't preserve meta" 187 | [map keyseq] 188 | (loop [ret (transient {}) keys (seq keyseq)] 189 | (if keys 190 | (let [entry (find map (first keys))] 191 | (recur (if entry 192 | (conj! ret entry) 193 | ret) 194 | (next keys))) 195 | (persistent! ret)))) 196 | 197 | (defn merge' 198 | "Like merge, but uses transients" 199 | [m & mms] 200 | (persistent! (reduce conj! (transient (or m {})) mms))) 201 | 202 | (defn mapv' 203 | "Like mapv, but short-circuits on reduced" 204 | [f v] 205 | (let [c (count v)] 206 | (loop [ret (transient []) i 0] 207 | (if (> c i) 208 | (let [val (f (nth v i))] 209 | (if (reduced? val) 210 | (reduced (persistent! (reduce conj! (conj! ret @val) (subvec v (inc i))))) 211 | (recur (conj! ret val) (inc i)))) 212 | (persistent! ret))))) 213 | 214 | (defn source-info 215 | "Returns the available source-info keys from a map" 216 | [m] 217 | (when (:line m) 218 | (select-keys' m #{:file :line :column :end-line :end-column :source-span}))) 219 | 220 | (defn -source-info 221 | "Returns the source-info of x" 222 | [x env] 223 | (merge' (source-info env) 224 | (source-info (meta x)) 225 | (when-let [file (and (not= *file* "NO_SOURCE_FILE") 226 | *file*)] 227 | {:file file}))) 228 | 229 | (defn const-val 230 | "Returns the value of a constant node (either :quote or :const)" 231 | [{:keys [form val]}] 232 | (or val form)) 233 | 234 | (def mmerge 235 | "Same as (fn [m1 m2] (merge-with merge m2 m1))" 236 | #(merge-with merge' %2 %1)) 237 | -------------------------------------------------------------------------------- /src/main/dotnet/packager/clojure.tools.analyzer.csproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | netstandard2.0;netstandard2.1 5 | 6 | 7 | 8 | clojure.tools.analyzer 9 | clojure.tools 10 | clojure.tools.analyzer 11 | clojure.tools.analyzer 12 | clojure.tools.analyzer 13 | ClojureCLR contributors 14 | A port of the tools.analyzer library to ClojureCLR. 15 | Copyright © Rich Hickey, ClojureCLR contributors 16 | EPL-1.0 17 | https://github.com/clojure/clojure.tools.analyzer 18 | ClojureCLR contributors 19 | Clojure;ClojureCLR 20 | 1.1.1 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /src/main/dotnet/packager/clojure.tools.analyzer.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 17 4 | VisualStudioVersion = 17.4.33103.184 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "clojure.tools.analyzer", "clojure.tools.analyzer.csproj", "{A2F25F49-41E8-489A-8245-1A848CAFB1D6}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|Any CPU = Debug|Any CPU 11 | Release|Any CPU = Release|Any CPU 12 | EndGlobalSection 13 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 14 | {A2F25F49-41E8-489A-8245-1A848CAFB1D6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 15 | {A2F25F49-41E8-489A-8245-1A848CAFB1D6}.Debug|Any CPU.Build.0 = Debug|Any CPU 16 | {A2F25F49-41E8-489A-8245-1A848CAFB1D6}.Release|Any CPU.ActiveCfg = Release|Any CPU 17 | {A2F25F49-41E8-489A-8245-1A848CAFB1D6}.Release|Any CPU.Build.0 = Release|Any CPU 18 | EndGlobalSection 19 | GlobalSection(SolutionProperties) = preSolution 20 | HideSolutionNode = FALSE 21 | EndGlobalSection 22 | GlobalSection(ExtensibilityGlobals) = postSolution 23 | SolutionGuid = {C8D02027-FB8B-46F2-BCC1-E9B29C8744F2} 24 | EndGlobalSection 25 | EndGlobal 26 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/analyzer/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.analyzer.core-test 2 | (:refer-clojure :exclude [macroexpand-1]) 3 | (:require [clojure.tools.analyzer :as ana] 4 | [clojure.tools.analyzer.ast :refer [postwalk]] 5 | [clojure.tools.analyzer.env :refer [with-env]] 6 | [clojure.tools.analyzer.passes.elide-meta :refer [elides elide-meta]] 7 | [clojure.test :refer [deftest is]] 8 | [clojure.tools.analyzer.utils :refer [resolve-sym]])) 9 | 10 | (defn desugar-host-expr [[op & expr :as form]] 11 | (if (symbol? op) 12 | (let [opname (name op)] 13 | (cond 14 | 15 | (= (first opname) \.) ; (.foo bar ..) 16 | (let [[target & args] expr 17 | args (list* (symbol (subs opname 1)) args)] 18 | (with-meta (list '. target (if (= 1 (count args)) ;; we don't know if (.foo bar) is 19 | (first args) args)) ;; a method call or a field access 20 | (meta form))) 21 | 22 | (= (last opname) \.) ;; (class. ..) 23 | (with-meta (list* 'new (symbol (subs opname 0 (dec (count opname)))) expr) 24 | (meta form)) 25 | 26 | :else form)) 27 | form)) 28 | 29 | (defn macroexpand-1 [form env] 30 | (if (seq? form) 31 | (let [op (first form)] 32 | (if (ana/specials op) 33 | form 34 | (let [v (resolve-sym op env)] 35 | (if (and (not (-> env :locals (get op))) ;; locals cannot be macros 36 | (:macro (meta v))) 37 | (apply v form env (rest form)) ; (m &form &env & args) 38 | (desugar-host-expr form))))) 39 | form)) 40 | 41 | (defmacro foo [] 1) 42 | 43 | (def e {:context :ctx/expr 44 | :locals {} 45 | :ns 'user}) 46 | 47 | (def e1 (atom {:namespaces {'user {:mappings (into (ns-map 'clojure.core) 48 | {'foo #'foo}) 49 | :aliases {} 50 | :ns 'user} 51 | 'clojure.core {:mappings (ns-map 'clojure.core) 52 | :aliases {} 53 | :ns 'clojure.core}}})) 54 | (defmacro ast [form] 55 | `(binding [ana/macroexpand-1 macroexpand-1 56 | ana/create-var ~(fn [sym env] 57 | (doto (intern (:ns env) sym) 58 | (reset-meta! (meta sym)))) 59 | ana/parse ana/-parse 60 | ana/var? ~var? 61 | elides {:all #{:line :column :file :source-span}}] 62 | (with-env e1 63 | (postwalk (ana/analyze '~form e) elide-meta)))) 64 | 65 | (defmacro mexpand [form] 66 | `(with-env e1 67 | (macroexpand-1 '~form e))) 68 | 69 | (deftest analyzer-test 70 | 71 | (let [nil-ast (ast nil)] 72 | (is (= :const (:op nil-ast))) 73 | (is (= :nil (:type nil-ast))) 74 | (is (:literal? nil-ast))) 75 | 76 | (let [v-ast (ast ^:foo [1 2])] 77 | (is (= :with-meta (:op v-ast))) 78 | (is (= :map (-> v-ast :meta :op))) 79 | (is (= {:foo true} (-> v-ast :meta :form))) 80 | (is (= [1 2] (-> v-ast :expr :form)))) 81 | 82 | (let [m-ast (ast {:a 1 :b 2})] 83 | (is (= {:a 1 :b 2} (:form m-ast))) 84 | (is (= [:a :b] (->> m-ast :keys (mapv :form)))) 85 | (is (= [1 2] (->> m-ast :vals (mapv :form))))) 86 | 87 | (is (= 'a (mexpand a))) 88 | (is (= ::foo (mexpand ::foo))) 89 | (is (= '(new foo) (mexpand (foo.)))) 90 | (is (= '(new foo a) (mexpand (foo. a)))) 91 | (is (= 'foo/bar (mexpand foo/bar))) 92 | (is (= '(. bar (foo 1)) (mexpand (.foo bar 1)))) 93 | (is (= '(. bar foo) (mexpand (.foo bar)))) 94 | (is (= 1 (mexpand (user/foo)))) 95 | 96 | (let [s-ast (:expr (ast '+))] 97 | (is (= :symbol (:type s-ast))) 98 | (is (= '+ (:form s-ast)))) 99 | 100 | (let [v-ast (ast +)] 101 | (is (= :var (:op v-ast))) 102 | (is (= '+ (:form v-ast))) 103 | (is (= #'+ (:var v-ast))) 104 | (is (not (:assignable? v-ast)))) 105 | 106 | (is (:assignable? (ast *warn-on-reflection*))) 107 | 108 | (let [mh-ast (ast foo/bar)] 109 | (is (= :maybe-host-form (:op mh-ast))) 110 | (is (= 'foo (:class mh-ast))) 111 | (is (= 'bar (:field mh-ast)))) 112 | 113 | (let [mc-ast (ast bar)] 114 | (is (= :maybe-class (:op mc-ast))) 115 | (is (= 'bar (:class mc-ast)))) 116 | 117 | (let [l-ast (ast (let [a 1] a))] 118 | (is (= :local (-> l-ast :body :ret :op))) 119 | (is (= :let (-> l-ast :body :ret :local)))) 120 | 121 | (let [do-ast (ast (do 1 2 3))] 122 | (is (= 3 (-> do-ast :ret :form))) 123 | (is (= [1 2] (->> do-ast :statements (mapv :form)))) 124 | (is (= :ctx/statement (-> do-ast :statements first :env :context)))) 125 | 126 | (let [if-ast (ast (if 1 2 3))] 127 | (is (= [1 2 3] (->> if-ast ((juxt :test :then :else)) (mapv :form))))) 128 | 129 | (let [new-ast (ast (foo. 1 2))] 130 | (is (= 'foo (-> new-ast :class :form))) 131 | (is (= [1 2] (->> new-ast :args (mapv :form))))) 132 | 133 | (let [q-ast (:expr (ast '^{a b} [c d]))] 134 | (is (= :const (-> q-ast :meta :op))) 135 | (is (= :const (-> q-ast :op))) 136 | (is (= '{a b} (-> q-ast :meta :form))) 137 | (is (= '[c d] (-> q-ast :form)))) 138 | 139 | (let [s-ast (ast (set! *warn-on-reflection* true))] 140 | (is (= :set! (:op s-ast))) 141 | (is (= #'*warn-on-reflection* (-> s-ast :target :var))) 142 | (is (= true (-> s-ast :val :form)))) 143 | 144 | (let [t-ast (ast (try 0 (catch E1 e e) (catch E2 e 2) (finally 3)))] 145 | (is (= 0 (-> t-ast :body :ret :form))) 146 | (is (= 2 (-> t-ast :catches second :body :ret :form))) 147 | (is (= :maybe-class (-> t-ast :catches first :class :op))) 148 | (is (= 'E1 (-> t-ast :catches first :class :class))) 149 | (is (= 'e (-> t-ast :catches first :local :name))) 150 | (is (= 3 (-> t-ast :finally :ret :form)))) 151 | 152 | (let [lfn-ast (ast (letfn [(a [] (b)) (b [] (a))] a))] 153 | (is (= :letfn (-> lfn-ast :body :ret :local))) 154 | (is (= '#{a b} (->> lfn-ast :bindings (mapv :name) set)))) 155 | 156 | (let [l-ast (ast (loop [x 1] (recur 2)))] 157 | (is (= :loop (-> l-ast :bindings first :local))) 158 | (is (= :ctx/return (-> l-ast :body :env :context)))) 159 | 160 | (let [f-ast (:ret (ast (fn a ([y & x] [x y]) ([] a) ([z] z))))] 161 | (is (= 1 (-> f-ast :max-fixed-arity)) (:meta f-ast)) 162 | (is (:variadic? f-ast)) 163 | (is (= true (-> f-ast :methods first :variadic?)))) 164 | 165 | (let [d-ast (ast (def ^{c d} a 1))] 166 | (is (= 'a (-> d-ast :name))) 167 | (is (= '{c d} (-> d-ast :var meta (dissoc :line :column :file :source-span)))) 168 | (is (= (ns-resolve 'user 'a) 169 | (-> e1 deref :namespaces (get 'user) :mappings (get 'a))))) 170 | 171 | (let [hc-ast (ast (.foo bar baz))] 172 | (is (= :host-call (-> hc-ast :op))) 173 | (is (= 'foo (-> hc-ast :method)))) 174 | 175 | (let [hf-ast (ast (.-foo bar))] 176 | (is (= :host-field (-> hf-ast :op))) 177 | (is (= 'foo (-> hf-ast :field)))) 178 | 179 | (let [hi-ast (ast (.foo bar))] 180 | (is (= :host-interop (-> hi-ast :op))) 181 | (is (= 'foo (-> hi-ast :m-or-f)))) 182 | 183 | (let [i-ast (ast (1 2))] 184 | (is (= :invoke (-> i-ast :op))) 185 | (is (= 1 (-> i-ast :fn :form))) 186 | (is (= [2] (->> i-ast :args (mapv :form))))) 187 | 188 | (let [def-ast (ast (def a))] 189 | (is (= :def (-> def-ast :op))) 190 | (is (empty? (-> def-ast :children))) 191 | (is (nil? (:init def-ast)))) 192 | 193 | (let [def-ast (ast (def a nil))] 194 | (is (= :def (-> def-ast :op))) 195 | (is (= [:init] (:children def-ast))) 196 | (is (= :const (-> def-ast :init :op)))) 197 | 198 | (let [def-ast (ast (def a "doc" nil))] 199 | (is (= :def (-> def-ast :op))) 200 | (is (= [:meta :init] (:children def-ast))) 201 | (is (= "doc" (-> def-ast :doc))) 202 | (is (= :const (-> def-ast :init :op))))) 203 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/analyzer/passes_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.analyzer.passes-test 2 | (:refer-clojure :exclude [macroexpand-1]) 3 | (:require [clojure.tools.analyzer.ast :refer :all] 4 | [clojure.test :refer [deftest is]] 5 | [clojure.set :as set] 6 | [clojure.tools.analyzer.core-test :refer [ast e e1]] 7 | [clojure.tools.analyzer.passes.add-binding-atom :refer [add-binding-atom]] 8 | [clojure.tools.analyzer.passes.source-info :refer [source-info]] 9 | [clojure.tools.analyzer.passes.uniquify :refer [uniquify-locals]] 10 | [clojure.tools.analyzer.passes.constant-lifter :refer [constant-lift]] 11 | [clojure.tools.analyzer.passes.emit-form :refer [emit-form emit-hygienic-form]] 12 | [clojure.tools.analyzer.env :refer [with-env]])) 13 | 14 | (deftest passes-utils-test 15 | (let [ast {:foo [{:a 1} {:a 2}] :bar [{:a 3}] :children [:foo :bar]}] 16 | (is (= 2 (-> ast (prewalk (fn [ast] (if (:a ast) 17 | (update-in ast [:a] inc) 18 | ast))) 19 | :foo first :a))) 20 | (is (= 2 (-> ast (postwalk (fn [ast] (if (:a ast) 21 | (update-in ast [:a] inc) 22 | ast))) 23 | :foo first :a))) 24 | (is (= nil (-> ast (walk (fn [ast] (dissoc ast :a)) 25 | (fn [ast] (if (:a ast) 26 | (update-in ast [:a] inc) 27 | ast))) 28 | :foo first :a))) 29 | (is (= [3 2 1] (let [a (atom [])] 30 | (-> ast (postwalk 31 | (fn [ast] (when-let [el (:a ast)] 32 | (swap! a conj el)) 33 | ast) :reversed)) 34 | @a))) 35 | (is (= [[{:a 1} {:a 2}] [{:a 3}]] (mapv second (children* ast)))) 36 | (is (= [{:a 1} {:a 2} {:a 3}] (children ast))))) 37 | 38 | (deftest add-binding-atom-test 39 | (let [the-ast (prewalk (ast (let [a 1] a)) 40 | (partial add-binding-atom (atom {})))] 41 | (swap! (-> the-ast :bindings first :atom) assoc :a 1) 42 | (is (= 1 (-> the-ast :body :ret :atom deref :a))))) 43 | 44 | (deftest source-info-test 45 | (is (= 1 (-> {:form ^{:line 1} [1]} source-info :env :line))) 46 | (is (= 1 (-> {:form ^{:column 1 :line 1} [1]} source-info :env :column))) 47 | (is (= 1 (-> {:form ^{:end-line 1 :line 1} [1]} source-info :env :end-line))) 48 | (is (= 1 (-> {:form ^{:end-column 1 :line 1} [1]} source-info :env :end-column)))) 49 | 50 | (deftest constant-lift-test 51 | (is (= :const (-> (ast {:a {:b :c}}) (postwalk constant-lift) :op))) 52 | (is (not= :const (-> (ast {:a {:b #()}}) (postwalk constant-lift) :op))) 53 | (is (= :const (-> (ast [:foo 1 "bar" #{#"baz" {23 []}}]) 54 | (postwalk constant-lift) :op)))) 55 | 56 | (deftest uniquify-test 57 | (let [the-ast (with-env e1 58 | (uniquify-locals (ast (let [x 1 y x x (let [x x] x)] 59 | (fn [y] x)))))] 60 | (is (= 'x__#2 (-> the-ast :body :ret :ret :methods first :body :ret :name))) 61 | (is (= 'y__#1 (-> the-ast :body :ret :ret :methods first :params first :name))) 62 | (is (apply not= (->> the-ast :bindings (mapv :name)))))) 63 | 64 | (deftest emit-form-test 65 | (is (= 1 (emit-form (ast 1)))) 66 | (is (= "a" (emit-form (ast "a")))) 67 | (is (= :foo/bar (emit-form (ast :foo/bar)))) 68 | (is (= 'a (emit-form (ast a)))) 69 | (is (= 'a/b (emit-form (ast a/b)))) 70 | (is (= 'a.b (emit-form (ast a.b)))) 71 | (is (= 'a.b/c (emit-form (ast a.b/c)))) 72 | (is (= '(. b (a c)) (emit-form (ast (.a b c))))) 73 | (is (= '(. b (a (c))) (emit-form (ast (.a b (c)))))) 74 | (is (= '(. b -a) (emit-form (ast (.-a b))))) 75 | (is (= '(. b a) (emit-form (ast (.a b))))) 76 | (is (= '(let* [a 1] a) (emit-form (ast (let [a 1] a))))) 77 | (is (= '(fn* ([] nil)) (emit-form (ast (fn []))))) 78 | (is (= '(fn* ([] nil) ([a] nil)) (emit-form (ast (fn ([]) ([a])))))) 79 | (is (= '(loop* [a 1] (recur 2)) (emit-form (ast (loop [a 1] (recur 2)))))) 80 | (is (= ''a (emit-form (ast 'a)))) 81 | (is (= [1 2 3] (emit-form (ast [1 2 3])))) 82 | (is (= {:a 1 [:b] 2} (emit-form (ast {:a 1 [:b] 2})))) 83 | (is (= {:a 1} (meta (emit-form (ast ^{:a 1} [:foo]))))) 84 | (is (= '(do 1) (emit-form (ast (do 1))))) 85 | (is (= '(do a b c) (emit-form (ast (do a b c))))) 86 | (is (= '(if 1 2) (emit-form (ast (if 1 2))))) 87 | (is (= '(if 1 2 3) (emit-form (ast (if 1 2 3))))) 88 | (is (= '(new a b c) (emit-form (ast (a. b c))))) 89 | (is (= '(set! a 1) (emit-form (ast (set! a 1))))) 90 | (is (= '(def a 1) (emit-form (ast (def a 1))))) 91 | (is (= '(def a "doc" 1) (emit-form (ast (def a "doc" 1))))) 92 | (is (= '(a b) (emit-form (ast (a b))))) 93 | (is (= '(try (throw 1) (catch e t b) (finally 2)) 94 | (emit-form (ast (try (throw 1) (catch e t b) (finally 2))))))) 95 | 96 | (deftest emit-hygienic-form-test 97 | (with-env e1 98 | (is (= '(let* [a__#0 1 a__#1 a__#0] a__#1) 99 | (emit-hygienic-form (uniquify-locals (ast (let [a 1 a a] a)))))) 100 | (is (= '(let* [x__#0 1] (fn* ([x__#1] x__#1))) 101 | (emit-hygienic-form (uniquify-locals (ast (let [x 1] (fn [x] x))))))) 102 | (is (= '(fn* x__#0 ([x__#1] x__#1)) 103 | (emit-hygienic-form (uniquify-locals (ast (fn x [x] x)))))))) 104 | 105 | (deftest deeply-nested-uniquify 106 | (is (= '(fn* ([x__#0 y__#0 z__#0] 107 | (let* [foo__#0 (fn* ([y__#1 z__#1] [y__#1 z__#1]))] 108 | (foo__#0 x__#0 y__#0)))) 109 | (with-env e1 110 | (emit-hygienic-form (uniquify-locals (ast (fn [x y z] 111 | (let [foo (fn [y z] 112 | [y z])] 113 | (foo x y)))))))))) 114 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/analyzer/query_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.analyzer.query-test 2 | (:refer-clojure :exclude [macroexpand-1]) 3 | (:require [clojure.tools.analyzer.ast :refer :all] 4 | [clojure.test :refer [deftest is]] 5 | [clojure.tools.analyzer.core-test :refer [ast e]] 6 | [clojure.tools.analyzer.ast.query :refer [q]] 7 | [clojure.tools.analyzer.ast :as ast] 8 | [clojure.tools.analyzer.utils :refer [compile-if]] 9 | [clojure.tools.analyzer.passes.index-vector-nodes :refer [index-vector-nodes]])) 10 | 11 | (def clojure-version-seven-query 12 | '[:find ?docstring 13 | :where 14 | [?def :op :def] 15 | [?def :init ?fn] 16 | [?fn :methods ?method] 17 | [?method :body ?body] 18 | [?body :statements ?statement] 19 | [?statement :val ?docstring] 20 | [?statement :type :string] 21 | [?statement :idx 0]]) 22 | 23 | (def clojure-version-eight-and-above-query 24 | '[:find ?docstring 25 | :where 26 | [?def :op :def] 27 | [?def :init ?fn] 28 | [?fn :expr ?expr] 29 | [?expr :methods ?method] 30 | [?method :body ?body] 31 | [?body :statements ?statement] 32 | [?statement :val ?docstring] 33 | [?statement :type :string] 34 | [?statement :idx 0]]) 35 | 36 | (compile-if (Class/forName "datomic.Datom") 37 | (deftest query 38 | (let [ast (ast/prewalk (ast (defn x [] "misplaced docstring" 1)) 39 | index-vector-nodes) 40 | the-query (if (< (:minor *clojure-version*) 8) 41 | clojure-version-seven-query 42 | clojure-version-eight-and-above-query)] 43 | (is (= "misplaced docstring" 44 | (ffirst (q the-query [ast]))))))) 45 | --------------------------------------------------------------------------------