├── .gitignore ├── LICENSE ├── README.mkd ├── developer_log.mkd ├── epl-v10.html ├── project.clj └── src └── cljs └── terra ├── analyzer.clj ├── compiler.clj └── core.clj /.gitignore: -------------------------------------------------------------------------------- 1 | # Project related 2 | 3 | # Java related 4 | pom.xml 5 | *jar 6 | *.class 7 | 8 | # Leiningen 9 | classes/ 10 | lib/ 11 | native/ 12 | checkouts/ 13 | target/ 14 | .lein-deps-sum 15 | .lein-failures 16 | .lein-repl-history 17 | .lein-cljsbuild-repl 18 | .lein-plugins/ 19 | repl-port 20 | 21 | # Python 22 | *.pyc 23 | *.pyo 24 | /__pycache__/ 25 | 26 | # Ruby 27 | Gemfile.lock 28 | 29 | # Temp Files 30 | *.orig 31 | *~ 32 | .*.swp 33 | .*.swo 34 | *.tmp 35 | *.bak 36 | 37 | # Editors (IntelliJ / Eclipse) 38 | */.idea 39 | */.classpath 40 | */.project 41 | */.settings 42 | 43 | # OS X 44 | .DS_Store 45 | 46 | # Logging 47 | *.log 48 | 49 | # Docs 50 | autodoc/ 51 | 52 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Eclipse Public License - Version 1.0 3 | 4 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 5 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 6 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 7 | 8 | 1. DEFINITIONS 9 | 10 | "Contribution" means: 11 | 12 | a) in the case of the initial Contributor, the initial code and 13 | documentation distributed under this Agreement, and 14 | 15 | b) in the case of each subsequent Contributor: 16 | 17 | i) changes to the Program, and 18 | 19 | ii) additions to the Program; 20 | 21 | where such changes and/or additions to the Program originate from and are 22 | distributed by that particular Contributor. A Contribution 'originates' from 23 | a Contributor if it was added to the Program by such Contributor itself or 24 | anyone acting on such Contributor's behalf. Contributions do not include 25 | additions to the Program which: (i) are separate modules of software 26 | distributed in conjunction with the Program under their own license 27 | agreement, and (ii) are not derivative works of the Program. 28 | 29 | "Contributor" means any person or entity that distributes the Program. 30 | 31 | "Licensed Patents" mean patent claims licensable by a Contributor which are 32 | necessarily infringed by the use or sale of its Contribution alone or when 33 | combined with the Program. 34 | 35 | "Program" means the Contributions distributed in accordance with this 36 | Agreement. 37 | 38 | "Recipient" means anyone who receives the Program under this Agreement, 39 | including all Contributors. 40 | 41 | 2. GRANT OF RIGHTS 42 | 43 | a) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 45 | reproduce, prepare derivative works of, publicly display, publicly perform, 46 | distribute and sublicense the Contribution of such Contributor, if any, and 47 | such derivative works, in source code and object code form. 48 | 49 | b) Subject to the terms of this Agreement, each Contributor hereby grants 50 | Recipient a non-exclusive, worldwide, royalty-free patent license under 51 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 52 | transfer the Contribution of such Contributor, if any, in source code and 53 | object code form. This patent license shall apply to the combination of the 54 | Contribution and the Program if, at the time the Contribution is added by the 55 | Contributor, such addition of the Contribution causes such combination to be 56 | covered by the Licensed Patents. The patent license shall not apply to any 57 | other combinations which include the Contribution. No hardware per se is 58 | licensed hereunder. 59 | 60 | c) Recipient understands that although each Contributor grants the licenses 61 | to its Contributions set forth herein, no assurances are provided by any 62 | Contributor that the Program does not infringe the patent or other 63 | intellectual property rights of any other entity. Each Contributor disclaims 64 | any liability to Recipient for claims brought by any other entity based on 65 | infringement of intellectual property rights or otherwise. As a condition to 66 | exercising the rights and licenses granted hereunder, each Recipient hereby 67 | assumes sole responsibility to secure any other intellectual property rights 68 | needed, if any. For example, if a third party patent license is required to 69 | allow Recipient to distribute the Program, it is Recipient's responsibility 70 | to acquire that license before distributing the Program. 71 | 72 | d) Each Contributor represents that to its knowledge it has sufficient 73 | copyright rights in its Contribution, if any, to grant the copyright license 74 | set forth in this Agreement. 75 | 76 | 3. REQUIREMENTS 77 | 78 | A Contributor may choose to distribute the Program in object code form under 79 | its own license agreement, provided that: 80 | 81 | a) it complies with the terms and conditions of this Agreement; and 82 | 83 | b) its license agreement: 84 | 85 | i) effectively disclaims on behalf of all Contributors all warranties and 86 | conditions, express and implied, including warranties or conditions of title 87 | and non-infringement, and implied warranties or conditions of merchantability 88 | and fitness for a particular purpose; 89 | 90 | ii) effectively excludes on behalf of all Contributors all liability for 91 | damages, including direct, indirect, special, incidental and consequential 92 | damages, such as lost profits; 93 | 94 | iii) states that any provisions which differ from this Agreement are offered 95 | by that Contributor alone and not by any other party; and 96 | 97 | iv) states that source code for the Program is available from such 98 | Contributor, and informs licensees how to obtain it in a reasonable manner on 99 | or through a medium customarily used for software exchange. 100 | 101 | When the Program is made available in source code form: 102 | 103 | a) it must be made available under this Agreement; and 104 | 105 | b) a copy of this Agreement must be included with each copy of the Program. 106 | 107 | Contributors may not remove or alter any copyright notices contained within 108 | the Program. 109 | 110 | Each Contributor must identify itself as the originator of its Contribution, 111 | if any, in a manner that reasonably allows subsequent Recipients to identify 112 | the originator of the Contribution. 113 | 114 | 4. COMMERCIAL DISTRIBUTION 115 | 116 | Commercial distributors of software may accept certain responsibilities with 117 | respect to end users, business partners and the like. While this license is 118 | intended to facilitate the commercial use of the Program, the Contributor who 119 | includes the Program in a commercial product offering should do so in a 120 | manner which does not create potential liability for other Contributors. 121 | Therefore, if a Contributor includes the Program in a commercial product 122 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 123 | and indemnify every other Contributor ("Indemnified Contributor") against any 124 | losses, damages and costs (collectively "Losses") arising from claims, 125 | lawsuits and other legal actions brought by a third party against the 126 | Indemnified Contributor to the extent caused by the acts or omissions of such 127 | Commercial Contributor in connection with its distribution of the Program in 128 | a commercial product offering. The obligations in this section do not apply 129 | to any claims or Losses relating to any actual or alleged intellectual 130 | property infringement. In order to qualify, an Indemnified Contributor must: 131 | a) promptly notify the Commercial Contributor in writing of such claim, and 132 | b) allow the Commercial Contributor tocontrol, and cooperate with the 133 | Commercial Contributor in, the defense and any related settlement 134 | negotiations. The Indemnified Contributor may participate in any such claim 135 | at its own expense. 136 | 137 | For example, a Contributor might include the Program in a commercial product 138 | offering, Product X. That Contributor is then a Commercial Contributor. If 139 | that Commercial Contributor then makes performance claims, or offers 140 | warranties related to Product X, those performance claims and warranties are 141 | such Commercial Contributor's responsibility alone. Under this section, the 142 | Commercial Contributor would have to defend claims against the other 143 | Contributors related to those performance claims and warranties, and if a 144 | court requires any other Contributor to pay any damages as a result, the 145 | Commercial Contributor must pay those damages. 146 | 147 | 5. NO WARRANTY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 150 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 151 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 152 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 153 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 154 | appropriateness of using and distributing the Program and assumes all risks 155 | associated with its exercise of rights under this Agreement , including but 156 | not limited to the risks and costs of program errors, compliance with 157 | applicable laws, damage to or loss of data, programs or equipment, and 158 | unavailability or interruption of operations. 159 | 160 | 6. DISCLAIMER OF LIABILITY 161 | 162 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 163 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 164 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 165 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 166 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 167 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 168 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 169 | OF SUCH DAMAGES. 170 | 171 | 7. GENERAL 172 | 173 | If any provision of this Agreement is invalid or unenforceable under 174 | applicable law, it shall not affect the validity or enforceability of the 175 | remainder of the terms of this Agreement, and without further action by the 176 | parties hereto, such provision shall be reformed to the minimum extent 177 | necessary to make such provision valid and enforceable. 178 | 179 | If Recipient institutes patent litigation against any entity (including a 180 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 181 | (excluding combinations of the Program with other software or hardware) 182 | infringes such Recipient's patent(s), then such Recipient's rights granted 183 | under Section 2(b) shall terminate as of the date such litigation is filed. 184 | 185 | All Recipient's rights under this Agreement shall terminate if it fails to 186 | comply with any of the material terms or conditions of this Agreement and 187 | does not cure such failure in a reasonable period of time after becoming 188 | aware of such noncompliance. If all Recipient's rights under this Agreement 189 | terminate, Recipient agrees to cease use and distribution of the Program as 190 | soon as reasonably practicable. However, Recipient's obligations under this 191 | Agreement and any licenses granted by Recipient relating to the Program shall 192 | continue and survive. 193 | 194 | Everyone is permitted to copy and distribute copies of this Agreement, but in 195 | order to avoid inconsistency the Agreement is copyrighted and may only be 196 | modified in the following manner. The Agreement Steward reserves the right to 197 | publish new versions (including revisions) of this Agreement from time to 198 | time. No one other than the Agreement Steward has the right to modify this 199 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 200 | Eclipse Foundation may assign the responsibility to serve as the Agreement 201 | Steward to a suitable separate entity. Each new version of the Agreement will 202 | be given a distinguishing version number. The Program (including 203 | Contributions) may always be distributed subject to the version of the 204 | Agreement under which it was received. In addition, after a new version of 205 | the Agreement is published, Contributor may elect to distribute the Program 206 | (including its Contributions) under the new version. Except as expressly 207 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 208 | licenses to the intellectual property of any Contributor under this 209 | Agreement, whether expressly, by implication, estoppel or otherwise. All 210 | rights in the Program not expressly granted under this Agreement are 211 | reserved. 212 | 213 | This Agreement is governed by the laws of the State of Washington and the 214 | intellectual property laws of the United States of America. No party to this 215 | Agreement will bring a legal action under this Agreement more than one year 216 | after the cause of action arose. Each party waives its rights to a jury trial 217 | in any resulting litigation. 218 | -------------------------------------------------------------------------------- /README.mkd: -------------------------------------------------------------------------------- 1 | 2 | ClojureScript-Terra 3 | =================== 4 | 5 | `ClojureScript Terra` is a [ClojureScript](https://github.com/clojure/clojurescript/) compiler that targets [Terra](https://github.com/zdevito/terra). 6 | 7 | This is the extracted design information from the developer log. 8 | 9 | The original project was called *Clojure/Cyclone Inspired C*, or `CLIC`, based on 10 | a design question. The project in here is referred to as ClojureScript-Terra, 11 | given the path forward (enhancing Lua and Terra, writing a CLJS compiler) 12 | 13 | [Timothy Baldridge](https://github.com/halgari) has also been pursuing projects 14 | with similar goals. There could be a point where I migrate the efforts found 15 | here into one of his projects. 16 | 17 | Please see the [Implementation Notes](#implementation-notes) below for various 18 | modifications this project has made to ClojureScript and Terra 19 | 20 | There will be a refresh of this project (and the final missing pieces will be 21 | completed) when the cljs-bootstrap work settles a bit more. 22 | 23 | ## Rationale 24 | 25 | Clojure's opinions make for an attractive, well-balanced, powerful, and simple 26 | language, but there are no comparable options for highly-constrained 27 | applications: 28 | 29 | * Operating systems and kernels 30 | * Real-time computation 31 | * resource-sensitive and resource-constrained systems 32 | 33 | While Clojure and the JVM (and to some degree CLJS and V8) are advantageous in larger 34 | systems-of-systems engineering, they are not ideal or even acceptable for the 35 | fields listed above. Typically, such domains require or strive for: 36 | 37 | * Binary compatiblity with C (for library and ABI support) 38 | * LLVM compilation targets 39 | * Runtimes smaller than 500K 40 | * Deterministic runtime characteristics 41 | 42 | In some cases, Clojure (and the JVM) could be adapted to achieve some of the desired 43 | goals. Interfacing and adapting the use of something like [Javolution](javolution.org) 44 | would allow Clojure to be more deterministic and fulfill real-time requirements. 45 | 46 | Ideally, producing LLVM intermediate code would allow for a compilation chain 47 | to take advantage of [HSA tooling](http://hsafoundation.com/hsa-developer-tools/) 48 | and other advancements from LLVM targets. This is ideal for High-Performance 49 | computing as well as embedded (but highly specialized) Systems-on-a-Chip (SoC). 50 | 51 | The main design question is: 52 | 53 | What would C look like if it were designed today? 54 | 55 | C inspired by: 56 | 57 | * [Clojure](http://clojure.org/) 58 | * [Cyclone](http://cyclone.thelanguage.org/) 59 | 60 | To a lesser degree 61 | 62 | * [Rust](http://www.rust-lang.org/) 63 | * [SAClib](https://github.com/ohpauleez/saclib) 64 | * [BitC](http://www.bitc-lang.org/) 65 | * [Deca](https://code.google.com/p/decac/) 66 | * [Io](http://iolanguage.org/) - homoiconic, Smalltalk-OO 67 | * [Julia](http://julialang.org/) - homoiconic (like R) 68 | * [Terra](http://terralang.org) 69 | * [HackerNews Conversation](https://news.ycombinator.com/item?id=5702793) expands on the sweet-spot for Terra 70 | * [Original paper](http://terralang.org/pldi071-devito.pdf) 71 | * [Mjolnir](https://github.com/halgari/mjolnir) 72 | 73 | I would like something C-like/native that supports: 74 | 75 | * Namespaces 76 | * Protocols & ideally predicate dispatch 77 | * Persistent data structures with transients (or pods) and metadata 78 | * Region-based memory management with region inference 79 | * First class functions and proper closures 80 | * Destructuring/binding via data structures or pattern matching 81 | * The Sequence abstraction 82 | * The separation of state and identity (as found in Clojure) 83 | * Lazy and eager evaluation - lazy by default with functions for eagerness 84 | * Improved pointer safety and region checking 85 | * Immutability as default, while maintaining convenient array manipulation 86 | * Structs as Records with property access 87 | * Proper promises 88 | * Common FP functions/operations provided (all sequence oriented functions) 89 | * Some notion of memory safety 90 | * No requirement of an external runtime/virtual or operating system 91 | * Although using one should always remain an option 92 | 93 | The language should explore: 94 | 95 | * Separating the syntax from the language 96 | * Pluggable, Optional type systems, with a separate hook/phase in compilation 97 | * This includes the type system, checker (if any), and inference 98 | * The only requirement is that all type systems need to resolve to 99 | C types/OS memory 100 | * Pluggable, Optional exception handling (exception handling as a library) 101 | * Multi-stage programming 102 | * What the separation of state and identity looks like at low-level interactions 103 | * Can this all be implemented cleanly on top of C (ala SAClib)? 104 | * Optional GC - either in place of the region system, or on top of the region system 105 | * Maybe this implies regions are opt-in? 106 | 107 | Additional (but orthogonal) explorations include: 108 | 109 | * Multiple Language feature expressions with LLVM cross-compilation and linking 110 | * This could be built on something like Julia's `llvmcall` 111 | * Concurrency that supports Futures and CSP (state machines in parallel) at a minimum 112 | * This will most likely be built on [Ray](https://github.com/richardhundt/ray) (libuv) or Richard Hundt's predecessor [Luv](https://github.com/richardhundt/luv) (potentially his *ray* branch) 113 | * You could add the OS-Thread worker queue, but not allow any global access (new or cloned Terra/Lua states per work item), in a share-nothing style. 114 | * Terra interops with pthreads just fine; You could always fall back to low-level threading if appropriate. 115 | 116 | 117 | The language is never concerned with: 118 | 119 | * Binary compatibility with C++ (but won't be explicitly avoided) 120 | * Image-based runtimes (ala Smalltalk) 121 | 122 | 123 | ## Approach 124 | 125 | The [Developer Log](./developer_log.mkd) contains log entries as the ideas 126 | are explored one-by-one, and the design is evolved and shaped. Below is the 127 | most recent, collective view of the design. Please cross-reference that 128 | doc for additional information/links. 129 | 130 | The current approach is: 131 | 132 | Write a ClojureScript compiler on top of Terra (which in turn uses LuaJit). 133 | This allows a developer to choose from a language spectrum that covers: C -> 134 | Terra -> Lua(JIT) -> ClojureScript. In this spectrum C exists primarily for 135 | legacy reasons - where you'd want to embed Terra into an existing system, or 136 | where you'd want Terra's FFI to use a C library (legacy or hand-written). 137 | Terra's LLVM backing allows open, extensible, low-level compilation to any LLVM 138 | Target, while providing the tooling for such low-level code to be generated 139 | from higher level languages (Lua and ClojureScript). The generated/compiled 140 | code requires no runtime whatsoever. LuaJIT's resident memory space is about 141 | 300K, but executes code considerably faster than Python, PyPy, Julia, and V8. 142 | Terra statically links the LLVM libs, requiring no third-party dependencies for 143 | running the packaged runtime. 144 | 145 | In summary: 146 | 147 | * Binary compatibility with C 148 | * Extremely fast and efficient FFI, even when used dynamically 149 | * FFI Terra code can compile down (to an executable or shared-lib) 150 | * Embed in C applications 151 | * Small footprint (between 300K - 4mb when statically linked) 152 | * Compilation with no runtime dependency 153 | * Optional Runtime for dynamic scripting (or live code generation/optimization), 154 | with better performance characteristics than alternative scripting languages 155 | * ClojureScript for the highest-level of abstraction; AOT compilation (for the time being) 156 | * CLJS can be used purely for Lua (scripting on LuaJIT), Terra (low-level code), or both 157 | 158 | This approach allows for: 159 | 160 | * Talking directly to hardware if needed via C libs or something like [Snabb Switch](https://github.com/SnabbCo/snabbswitch/wiki) 161 | * See testimony [here](https://news.ycombinator.com/item?id=7250505) and follow links as needed. 162 | * Embedding into kernels, even real-time ones like [L4](https://os.inf.tu-dresden.de/L4Re/doc/l4re_servers_ned.html) 163 | * Building applications, scripts, runtime libraries, or AOT-compiled shared-libs 164 | * Building hard real-time applications on top of stock Linux [with some modifications](http://www.orocos.org/wiki/orocos/toolchain/luacookbook) 165 | 166 | But currently lacks: 167 | 168 | * Library support to the degree found in other languages (Python, JavaScript, Java) 169 | * limited to C, ClojureScript, and [lua libs](http://luarocks.org/repositories/rocks/); Virtually no Terra libs (language is new) 170 | * Complexity associated with the spectrum of multi-stage programming 171 | * For example, different tiers have different dispatch mechanisms that don't 172 | interop; Different exception handling mechanisms 173 | * Data structures differ between multi-stage tiers and must conform to interop 174 | rules 175 | 176 | 177 | ### The tiers 178 | 179 | #### Host, typed 180 | This is just C. 181 | 182 | #### Low-level, typed 183 | At this tier, code is targeting LLVM compilation and everything is typed. 184 | Mutability is default, and there is no memory safety. 185 | There is no formal notion of metadata or separation of state and identity. 186 | 187 | * Dict (to be written, based on HMap [here](https://github.com/dritchie/terra-utils)) 188 | * Array 189 | * Vector (this is special-purposed for SIMD; it's namespaced to avoid clashing) 190 | * Struct 191 | 192 | Dispatch is: 193 | * Function call 194 | * Interfaces (Go-like/protocol-like dispatch) 195 | 196 | #### Runtime, dynamic 197 | At this tier, code is dynamic and part of an active runtime (LuaJIT). 198 | This code is used for low-level generation, or the foundation for a dynamic 199 | application. Mutability is the default, there is memory safety. Exception 200 | handling is [protective calls](http://www.lua.org/pil/8.4.html), signaling, and recovery. 201 | There is no formal notion of metadata or separation of state and identity. 202 | 203 | * Table 204 | * TableList 205 | * Tree 206 | * Container (an object with no properties, only functions) 207 | * Object (a prototypical object; uses Lua's OO metatables pattern) 208 | * Peg (an LPeg pattern Object) 209 | 210 | Dispatch is: 211 | * Function call 212 | * Multimethods without hierarchies 213 | 214 | #### Generation, dynamic 215 | At this tier, code is compiled AOT to target the lower two tiers (runtime 216 | and low-level). This tier is very high-level and extensible. It champions 217 | simplistic systems, functional programming, immutability, and memory safety 218 | by default. There is full and extensible exception handling. There is full 219 | support for metadata and the separation of state and identity. 220 | 221 | * Map 222 | * List 223 | * Vector 224 | * ArrayMap 225 | * Set 226 | * Record 227 | 228 | Dispatch is: 229 | * Function call 230 | * Multimethods with hierarchies 231 | * Protocols 232 | * core.match-based 233 | 234 | 235 | ### TODO 236 | 237 | The current TODO is (See Jan 31,2014 and after in the dev log): 238 | 239 | * Build a better `stdlib` with LPeg included (and wrapped as an Object) 240 | * Integrate and refactor Terra with the new stdlib (details in dev log) 241 | * Add the Interface (Protocol) piece into Terra with reflection added 242 | * Write CLJS-Lua upon the new stdlib (supporting LuaJIT FFI and FFI calls) 243 | and LDoc 244 | * Make CLJS array operations protocol-based, add a `cljs.terra` namespace 245 | for the Terra specific features; Array opts should work on Arrays, Vectors, 246 | and TableLists 247 | * Replace `std.functional` with a `Mori`-like precompiled CLJS core 248 | * Data structures are first class in std (not in `functional`) 249 | * Rope in pieces from [Terra Utils](https://github.com/dritchie/terra-utils) 250 | * Add `llvm_call` to Terra and expose in `cljs.terra` 251 | * Package up the [MPS Memory Pool](http://www.ravenbrook.com/project/mps/) for 252 | Terra and expose in `cljs.terra.mempool` 253 | 254 | For details of these items (and their rationale), please read the [Developer Log](./developer_log.mkd). 255 | 256 | 257 | ## Implementation notes 258 | 259 | #### ClojureScript 260 | 261 | For now, the compiler infrastructure all comes from ClojureScript, which 262 | requires the JVM. It will output a single Terra file. 263 | 264 | One notable difference is the absence of `(js* ...)` forms, replaced with 265 | `(host* ...)` forms. This is intentionally done to make the compiler less 266 | js-specific. Note that Terra sits on top of Lua, so you can put valid Lua or 267 | Terra code in the `host*` form. It also means that this compiler uses an 268 | adapted CLJS analyzer. 269 | 270 | Lua optimizes tail calls. You should still write idiomatic Clojure (with 271 | explicit `recur` calls), but under the hood TCO is available and utilized 272 | at different points in the compiler. 273 | 274 | RegEx objects/literals are PEG literals in CLJS-Terra. Regular expressions can 275 | be captured as PEG Patterns. 276 | To make regex more convenient, any place that accepts a Match/Pattern/PEG 277 | literal, can also take a string. If a string is passed, it's treated as a 278 | Regular Expression. 279 | 280 | The LuaJIT compiler takes the place of the Google Closure compiler in 281 | CLJS-Terra. Controls are not currently in place, but you can see the levels 282 | of [optimizations and options](http://luajit.org/running.html). 283 | 284 | Low-level code (as defined by `defnf`, etc) can optionally be compiled to 285 | executables or shared libraries during runtime or compilation time (where 286 | ever the `terra/saveobj` call appears). 287 | 288 | #### Terra 289 | 290 | CLJS-Terra uses a custom `terralib`. Shims are in place to allow for full 291 | interoperability with the one found within Terra itself. 292 | 293 | 294 | ## Usage 295 | 296 | TODO 297 | 298 | - - - - 299 | 300 | ## License 301 | 302 | Copyright © 2014 Paul deGrandis 303 | 304 | The use and distribution terms for this software are covered by the 305 | [Eclipse Public License 1.0](http://opensource.org/licenses/eclipse-1.0) 306 | which can be found in the file [epl-v10.html](epl-v10.html) at the root of this distribution. 307 | 308 | By using this software in any fashion, you are agreeing to be bound by 309 | the terms of this license. 310 | 311 | You must not remove this notice, or any other, from this software. 312 | 313 | - - - - 314 | 315 | The ClojureScript compiler is distributed under the [Eclipse Public License version 1.0](http://opensource.org/licenses/EPL-1.0). 316 | 317 | Terra, Terra-utils, Lua, LPeg, stdlib, and LuaJIT are all under the [MIT License](http://opensource.org/licenses/mit-license.html). 318 | 319 | MPS Memory Pool is distributed under the [BDB / Sleepycat License](http://opensource.org/licenses/Sleepycat) 320 | 321 | -------------------------------------------------------------------------------- /developer_log.mkd: -------------------------------------------------------------------------------- 1 | Cyclone/Clojure Inspired C - CLIC (or CYCLIC) 2 | ============================================== 3 | 4 | ## Rationale 5 | 6 | Clojure's opinions make for an attractive, well-balanced, powerful, and simple 7 | language, but there are no comparable options for highly-constrained 8 | applications: 9 | 10 | * Operating systems and kernels 11 | * Real-time computation 12 | * resource-sensitive and resource-constrained systems 13 | 14 | While Clojure and the JVM (and to some degree CLJS and V8) are advantageous in larger 15 | systems-of-systems engineering, they are not ideal or even acceptable for the 16 | fields listed above. Typically, such domains require or strive for: 17 | 18 | * Binary compatiblity with C (for library and ABI support) 19 | * LLVM compilation targets 20 | * Runtimes smaller than 500K 21 | * Deterministic runtime characteristics 22 | 23 | In some cases, Clojure (and the JVM) could be adapted to achieve some of the desired 24 | goals. Interfacing and adapting the use of something like [Javolution](javolution.org) 25 | would allow Clojure to be more deterministic and fulfill real-time requirements. 26 | 27 | Ideally, producing LLVM intermediate code would allow for a compilation chain 28 | to take advantage of [HSA tooling](http://hsafoundation.com/hsa-developer-tools/) 29 | and other advancements from LLVM targets. This is ideal for High-Performance 30 | computing as well as embedded (but highly specialized) Systems-on-a-Chip (SoC). 31 | 32 | The main design question is: 33 | 34 | What would C look like if it were designed today? 35 | 36 | C inspired by: 37 | 38 | * [Clojure](http://clojure.org/) 39 | * [Cyclone](http://cyclone.thelanguage.org/) 40 | 41 | To a lesser degree 42 | 43 | * [Rust](http://www.rust-lang.org/) 44 | * [SAClib](https://github.com/ohpauleez/saclib) 45 | * [BitC](http://www.bitc-lang.org/) 46 | * [Deca](https://code.google.com/p/decac/) 47 | * [Io](http://iolanguage.org/) - homoiconic 48 | * [Julia](http://julialang.org/) - homoiconic (like R) 49 | * [Terra](http://terralang.org) 50 | * [HackerNews Conversation](https://news.ycombinator.com/item?id=5702793) expands on the sweet-spot for Terra 51 | * [Original paper](http://terralang.org/pldi071-devito.pdf) 52 | * [Mjolnir](https://github.com/halgari/mjolnir) 53 | 54 | I would like something C-like/native that supports: 55 | 56 | * Namespaces 57 | * Protocols & ideally predicate dispatch 58 | * Persistent data structures with transients (or pods) and metadata 59 | * Region-based memory management with region inference 60 | * First class functions and proper closures 61 | * Destructuring/binding via data structures or pattern matching 62 | * The Sequence abstraction 63 | * Lazy and eager evaluation - lazy by default with functions for eagerness 64 | * Improved pointer safety and region checking 65 | * Immutability as default, while maintaining convenient array manipulation 66 | * Structs as Records with property access 67 | * Proper promises 68 | * Common FP functions/operations provided (all sequence oriented functions) 69 | * Some notion of memory safety 70 | * No requirement of an external runtime/virtual or operating system 71 | * Although using one should always remain an option 72 | 73 | The language should explore: 74 | 75 | * Separating the syntax from the language 76 | * Pluggable, Optional type systems, with a separate hook/phase in compilation 77 | * This includes the type system, checker (if any), and inference 78 | * The only requirement is that all type systems need to resolve to 79 | C types/OS memory 80 | * Pluggable, Optional exception handling (exception handling as a library) 81 | * Multi-stage programming 82 | * Can this all be implemented cleanly on top of C (ala SAClib)? 83 | * Optional GC - either in place of the region system, or on top of the region system 84 | * Maybe this implies regions are opt-in? 85 | 86 | Additional (but orthogonal) explorations include: 87 | 88 | * Multiple Language feature expressions with LLVM cross-compilation and linking 89 | * This could be built on something like Julia's `llvmcall` 90 | * Concurrency that supports Futures and CSP (state machines in parallel) at a minimum 91 | 92 | The language is never concerned with: 93 | 94 | * Binary compatibility with C++ 95 | * Image-based runtimes (ala Smalltalk) 96 | 97 | 98 | - - - - 99 | What follows is a developer journal as the ideas are explored one-by-one. 100 | 101 | The current approach is: 102 | 103 | Write a ClojureScript compiler on top of Terra (which in turn uses LuaJit). 104 | This allows a developer to choose from a language spectrum that covers: 105 | C -> Terra -> Lua(JIT) -> ClojureScript. In this spectrum C exists only for 106 | legacy reasons - where you'd want to embed Terra into an existing system, or 107 | where you'd want Terra's FFI to use a legacy library. Terra's LLVM backing 108 | allows open, extensible, low-level compilation to LLVM Target, while 109 | providing the tooling for such low-level code to be generated from higher level 110 | languages (Lua and ClojureScript). The generated/compiled code requires no 111 | runtime whatsoever. LuaJIT's resident memory space is about 300K, but executes 112 | code considerably faster than Python, PyPy, Julia, and V8. Terra statically 113 | links the LLVM libs, requiring no third-party dependencies for running the packaged 114 | runtime. 115 | 116 | In summary: 117 | 118 | * Binary compatibility with C (Fastest FFI of all languages) 119 | * Embed in C applications 120 | * Small footprint 121 | * Compilation with no runtime dependency 122 | * Optional Runtime for dynamic scripting (or live code generation/optimization), 123 | with better performance charateristic than alternative scripting languages 124 | * ClojureScript for the highest-level of abstraction; AOT compilation (for the time being) 125 | * CLJS can be used purely for Lua (scripting on LuaJIT), Terra (low-level code), or both 126 | 127 | This approach allows for: 128 | 129 | * Talking directly to hardware if needed ala C libs or something like [Snabb Switch](https://github.com/SnabbCo/snabbswitch/wiki) 130 | * See testimony [here](https://news.ycombinator.com/item?id=7250505) and follow links as needed. 131 | * Embedding into kernels, even real-time ones like [L4](https://os.inf.tu-dresden.de/L4Re/doc/l4re_servers_ned.html) 132 | * Building applications, scripts, runtime libraries, or AOT-compiled shared-libs 133 | * Building hard real-time applications on top of stock Linux [with some modifications](http://www.orocos.org/wiki/orocos/toolchain/luacookbook) 134 | 135 | The current TODO is (See Jan 31,2014 and after): 136 | 137 | * Build a better `stdlib` with LPeg included (and wrapped as an Object) 138 | * Integrate and refactor Terra with the new stdlib (details below) 139 | * Add the Interface (Protocol) piece into Terra with reflection added 140 | * Write CLJS-Lua upon the new stdlib (supporting LuaJIT FFI and FFI calls) and LDoc 141 | * Make CLJS array operations protocol-based, add a `cljs.terra` namespace 142 | for the Terra specific features 143 | * Replace `std.functional` with a `Mori`-like precompiled CLJS core 144 | * Data structures are first class in std (not in `functional`) 145 | * Rope in pieces from [Terra Utils](https://github.com/dritchie/terra-utils) 146 | * Add `llvm_call` to Terra and expose in `cljs.terra` 147 | * Package up the MPS memory pool for Terra and expose in `cljs.terra.mempool` 148 | 149 | For details of these items (and their rationale), please read below. 150 | - - - 151 | 152 | Note: I've been looking for a new language replacement in a niche I work in. 153 | I was finally pushed over the edge when I saw the quest to [replace Python](http://roscidus.com/blog/blog/2013/06/09/choosing-a-python-replacement-for-0install/) 154 | 155 | 156 | Originally, it seemed like the most attractive path forward was: 157 | 158 | * A C library with Terra support, for the base feature set 159 | * Additional libs in the same fashion, for auxiliary goals 160 | * Maybe ClojureScript-Terra - which could second as a CLJS-Lua. 161 | 162 | The C library could technically be written in Mjolnir or Terra. 163 | Technically, the two should be able to interop (they share a lot of similarities). 164 | 165 | In fact, Mjolnir (or something very close to it) could easily be ported to 166 | ClojureScript-Terra. 167 | Some of Mjolnir becomes redundant in the CLJS-Terra world, while other 168 | necessary pieces are missing (Datomic). The Datomic piece can be back filled 169 | on the back of the REST API, since EDN will still be first-class in CLJS-Terra 170 | 171 | Rough notes: 172 | * Mjolnir needs FFI (jna is sort of this) and something analogous to Terra's "escape" (which could be a pretty easy macro) 173 | * This is geting pretty close to [clojure-metal](https://github.com/halgari/clojure-metal) 174 | * Terra would need all the ClojureScript implementation 175 | * Both need regions introduced, Regions could look like hash maps 176 | * Both need low-level immutable data structures and ideally convenient syntax 177 | * cljs-terra can take the `mori` approach 178 | 179 | There are a lot of overlapping goals for clojure-metal as there are here. 180 | I disagree that we need to start from the VM level - Lua is a prime target. 181 | The promise of a completely thread-safe scripting language is nice though. 182 | Lua obviously achieves this by being single-threaded, but I plan on 183 | introducing a library of executors on POSIX threads, from the bottom up 184 | (from a native or C context). The same approach will be done for Regions. 185 | 186 | Terra's compilation (and some language features) are very similar to the work 187 | in Mjolnir. Both are viable paths forward (clojure-metal and clojurescript-lua 188 | are proof of this), but CLJS-Terra solves two major problems: the library 189 | phenomena, and an existing platform for embedding (Lua/Terra State). 190 | 191 | There is considerable work needed to refactor Terra's compiler-strategy into 192 | chunks that compose - something more akin to Mjolnir's strategy. 193 | From there, this individual pieces should be exposed to Terra directly. 194 | The real goal here is to have full control over the LLVM IR generation, Module 195 | creation, and ultimately, the final TargetMachine compilation. 196 | 197 | Once that is done, we can write a ClojureScript backend for Terra, using the 198 | CLJS-Lua code as a guide. We can modify Terra directly to include the necessary 199 | Lua libraries (json). We can also extend the language to include `defnf` - 200 | which will just be a terra function, where defn will be a normal lua function. 201 | 202 | The one concern is that Lua's GC may be sensitive to empheral garbage (high allocs, 203 | high trash), which will get hit when using immutable data structures. 204 | Terra is manually managed. The Safe programming language from UCM provides 205 | some light about region inference and compilation in functional programming 206 | languages. 207 | 208 | It would be a far-goal to use the Clojure-in-Clojure tool chain to compile the 209 | compiler into terra, or write the write the final compiler in terra itself and 210 | use the CLJS-written analyzer. 211 | 212 | 213 | Other links to be aware of: 214 | 215 | * [Public Domain C Lib](http://pdclib.e43.eu/) 216 | * [Glib](https://developer.gnome.org/glib/) could provide some base functionality I could build off of. 217 | * [A Port of Underscore called Moses](https://github.com/Yonaba/Moses) for Lua 218 | * Also, another [direct port](https://github.com/mirven/underscore.lua) 219 | * Numeric Computing for LuaJIT 2 - [lna](http://oproj.tuxfamily.org/release/2013/09/10/lna-release.html) 220 | * [LuaJIT numeric performance guide](http://wiki.luajit.org/Numerical-Computing-Performance-Guide) 221 | 222 | 223 | ### Looking into Terra's compilation 224 | 225 | While parts of the pipeline are very OO, most of it C-style imperative. 226 | The functions are all static calls, and the state of type-checking/compilation 227 | is attached to each Terra function like metadata. Sadly, that metadata is 228 | updated in place (compilation doesn't generate new functions) 229 | 230 | In order for that to work (currently), the compiler needs to be initialized 231 | ahead of time when Terra itself initializes. This is ok because compilation 232 | and optimization only go as far as LLVM IR. 233 | The trade-off is clear - you get one-time, upfront intialization and simplied 234 | tooling at the cost of little flexibility and no extension in the compiler itself. 235 | It definitely doesn't follow an open-closed principle. There is even an example of the real 236 | pain this causes - CUDA compilation requires an entirely different compiler 237 | path and takes up an additional environment var. The compiler is mostly used 238 | to write the final LLVM Module to PTX, `moduleToPTX`. 239 | 240 | Terra uses the older LLVM JIT instead of the newer MCJIT. 241 | This is because of the compilation strategy (and the desire to lazily compile 242 | functions as they're used). The newer MCJIT needs to compile complete modules 243 | at a time and you can't add functions to modules after the fact. 244 | We might come back and clean it up based on the [LLVM Blog Post](http://blog.llvm.org/2013/07/using-mcjit-with-kaleidoscope-tutorial.html) 245 | 246 | Here's the standard compilation lifecycle: 247 | 1. `tcompiler.cpp:terra_compilerinit` takes the `terra_State`, _T_, builds a new 248 | `compiler_State`, initializes the JIT memory setup, sets LLVM's Code gen 249 | optimization to aggressive, grabs the default Triple from LLVM, looks up 250 | the LLVM Machine that matches, and generates a new LLVM TargetMachine from 251 | that information. 252 | The important data is: 253 | * `T->C = new terra_CompilerState();` 254 | * `T->C->tm = TM;` The TargetMachine 255 | `TargetMachine * TM = TheTarget->createTargetMachine(Triple, "", HostHasAVX() ? "+avx" : "", options,Reloc::Default,CodeModel::Default,OL);` 256 | * `T->C->m = new Module("terra",*T->C->ctx);` 257 | * The ExecutionEngine is `T->C->ee` 258 | * `ee` does not reference tm 259 | * `tm` is only used in `T->C->mi = createManualFunctionInliningPass(T->C->tm);` 260 | * `mi` is only used in the optimization phase `terra_optimize`, which is later called in terra.optimize/context.finalize 261 | 1. `compilerinit` is called in `terra.cpp:terra_initwithoptions`, where the 262 | Terra State is established and Terra is fully initialized. This is also where 263 | Terra injects things into the Lua State (like top-level terra things) and 264 | does some init'd of luaJIT 265 | 1. `initwithoptions` is called from the top-level `terra.cpp:terra_init` 266 | 1. `terra_init` is called when embedding or in Terra's `main.cpp` 267 | 1. Actual compilation is triggered by `terralib.lua:saveobj` which calls the 268 | `emitllvm` function attached to the Terra functions 269 | 1. `emitllvm` is actually: `function terra.funcdefinition:emitllvm(cont)` 270 | which tracks the functions own compilation with state stored on `self` vars. 271 | The compiler context used, which is terra lib-global at: `local ctx = terra.getcompilecontext()` 272 | 1. `getcompilecontext` sets the global context Singleton: 273 | `terra.globalcompilecontext = setmetatable({definitions = {}, diagnostics = terra.newdiagnostics() , stack = {}, tobecompiled = {}, nextindex = 0, compileflags = {}},terra.context)` 274 | 1. The context is twiddled through `terra.context.*` functions, which in `terra.context.finalize` calls `terra.codegen` 275 | 1. Actual compilation happens with a call to `codegen` which is back in tcompiler.cpp 276 | 1. The heart of compilation is the `tcompiler.cpp:TerraCompiler`; the entrypoint in the compiler is `void run(terra_State * _T, int ref_table)` 277 | * `ee` and `m` are only used in `Value * emitExpRaw(Obj * exp)` 278 | 1. `Saveobj` writes the LLVM Module (of the Terra functions) to a machine 279 | specific object file or executable. 280 | * `tm` is used in `static int terra_saveobjimpl` and 281 | `static int terra_linklibraryimpl(lua_State * L)` 282 | - this could be passed in to override 283 | 1. A call to `terra.jit` would produce a jit compilation of the LLVM code for 284 | a given function. 285 | 286 | There are in tcompiler.cpp: 287 | 288 | ``` 289 | _(codegen,1) /*entry point from lua into compiler to generate LLVM for a function, other functions it calls may not yet exist*/\ 290 | _(optimize,1) /*entry point from lua into compiler to perform optimizations at the function level, passed an entire strongly connected component of functions\ 291 | all callee's of these functions that are not in this scc have already been optimized*/\ 292 | _(jit,1) /*entry point from lua into compiler to actually invoke the JIT by calling getPointerToFunction*/\ 293 | ``` 294 | 295 | TODO: 296 | * saveobj should allow for the final obj file to be written with a new triple (constructing a new TargetMachine), for line 2523 297 | * Port Julia's [llvmcall](https://github.com/JuliaLang/julia/pull/5046) function. 298 | * Code should be updated to [use MCJIT](https://github.com/zdevito/terra/issues/58) 299 | * Port lua-cjson to pure terra 300 | * Add [multi dispatch](https://gist.github.com/SegFaultAX/3364849) and [dir]() 301 | * Add something like [mori](https://github.com/swannodette/mori) and [ki](https://github.com/lantiga/ki), once the CLJS port is done 302 | * Wrap up [MPS Memory Pool](http://www.ravenbrook.com/project/mps/) 303 | * Write Terra versions of the data structures on top of MPS 304 | 305 | As I write cljs-terra, here are a list of things I need to go back and do: 306 | 307 | * Terra Arrays should be their own type (via deftype) 308 | * Terra Vectors should be their own type (via deftype) 309 | * Array functions should be a protocol, supporting Lua Tables, Terra Arrays, and Terra Vectors 310 | 311 | 312 | The current approach in CLJS-Lua for handling protocols (and other operations attached to built-in types) is to attach 313 | it to primitive metatables via `debug.setmetatable`. This is faster than having a global table and using a dispatch 314 | map, and is roughly the same as using proxies (via `newproxy`). It is still slower than a direct function call. 315 | 316 | To highly optimize the implementation, we could create a name munge process - something like `TYPE__PROTOCOL__FUNC__ARITY = function (...)` 317 | This seems messy and unwarranted - 10m function calls take 2 seconds on standard Lua; 10m metatable calls take 3 seconds 318 | 319 | 320 | (Jan 19, 2014) 321 | I've done most of the work to make the analyzer host-neutral. It still assumes there's some form of base "object" 322 | I'm mostly finished with the compiler and the core (core.clj). I've removed some js-specific pieces from core.clj, 323 | and replaced them with new keywords and macros/functions (that other backends can specify) that generate host/platform 324 | specific code. I benched various ways to implement multimethods and protocols in lua - the direction CLJS-Lua took 325 | (whether intentional or not) was the best balance between semantics, convenience, and speed. 326 | CLJS-Lua needed to supply a base `builtins` to smooth the interop between ClojureScripts semantics and the core language. 327 | It's still missing fundamental pieces, like RegExs, and provides wrappers which might not be necessary (for example, 328 | you don't really need to wrap Arrays just to comply with function calls in Lua, you could just use Tables and adjust 329 | the compiler and core. 330 | 331 | In the meantime - I've added `dir`, `range`, and a very limited (lua-only) `multimethod` to Terralib. I may remove the multimethod 332 | once the CLJS-Terra is in place (and generates decent Lua and/or Terra code), and just link it in ala `mori`. I'd also 333 | like to add in protocols at the Lua level - I may take the `mori` approach here as well. Otherwise, I can pull 334 | inspiration from [a JS attempt](https://github.com/Gozala/protocol) and the approach used in [Elixir](http://elixir-lang.org/getting_started/4.html) 335 | 336 | UPDATE: 337 | Terra already has protocols in the form of go-like object/interface systems, using structs. 338 | The working on the functions from "Interface" to "protocol" seems appropriate. 339 | 340 | 341 | (Jan 25, 2014) 342 | I'm unsure the best strategy for rolling the terra stuff in. I could just produce a `terra` call, like the anonymous function call, 343 | or a full `terra` function like a `defnf` form. The tricky part is that `let` bindings inside the function needed to be 344 | treated differently. I may just fall back to the same approach used in Mjolnir. 345 | Doing so would mean that CLJS-Terra is CLJS-Lua + a Terra specific library. The major tradeoff is going out of your way to 346 | write performance critical code, rather than having the CLJS compiler do the heavy lifting for you. 347 | I could also do the inverse - all functions/lets/etc are Terra specific, and offer Lua-variants as a library. This means 348 | the compiler (CLJS and Terra) do the heavy lifting for you, but you have to go out of your way to target pure Lua. 349 | 350 | Perhaps we can do the former, and use macro-magic + analyzer tweaks to make it feel as natural/effortless/direct as 351 | possible. 352 | 353 | 354 | (Jan 29, 2014) 355 | It's becoming very difficult to draw the line between letting CLJS generate Lua and generating Terra. 356 | A recent example - it'd be PERFECT to back Protocols on Terra's Go-like Interfaces. That won't work though because 357 | you'd need to make deftype/defrecord backed by Structs, which forces you to pull in memory pools early, or use 358 | manual memory management everywhere. 359 | Perhaps this can still be remedied with a Terra-specific library like mentioned above. This adds complexity in 360 | abstraction mismatch - `defstruct, definterface, extend-struct` vs `defrecord, defprotocol, extend-type`. The former 361 | is lower-level, requires manual memory management or only stack allocations, the latter is higher-level, managed. 362 | Another source of mismatch comes with array-based operations - in Lua, they work against Tables (being treated as an 363 | array) and in Terra they will need to be redefined to work on Arrays and Vectors (array functions will need to be 364 | a protocol) 365 | 366 | (Jan 30, 2014) 367 | There exists a [Lua Std Lib](http://rrthomas.github.io/lua-stdlib/) project that may fill in much of the missing (hand-written) 368 | functionality between Lua as a host and JS as a host. 369 | * A Prototype object system 370 | * A List that I can use as a cljs-array 371 | * String Bufers 372 | * Better IO, Math, and String capabilities 373 | * More FP oriented (but also has prototype-OO based interfaces for some things) 374 | 375 | If adopted, I would move multimethods, range, and dir to a clone of std-lib. 376 | I need to see the total file size of standard lib, and see how I roll it into Terra's compilation. 377 | 378 | It also seems like the Go-Like interface library is VERY efficient. I'm consider writing a 379 | protocol-like veneer on top of it, for style purposes only - and adding some metadata to structs 380 | (it's difficult to tell if a struct implements a protocol. The metadata approach in the Java-like 381 | system can easily be adapted) 382 | 383 | I'd also like to generate comments in the conventions set forth in [LDoc](https://github.com/stevedonovan/LDoc) 384 | 385 | It might make sense to repackage `std` with the Terra functionality I want in a 386 | single Terra file (with namespaced/tabled functionality) 387 | 388 | 389 | (Jan 31, 2014) 390 | After looking at [stdlib](https://github.com/rrthomas/lua-stdlib), [penlight](https://github.com/stevedonovan/Penlight), and [libmc](https://bitbucket.org/leafstorm/libmc/src), 391 | The best option looks like sticking with stdlib. 392 | 393 | I'd like to add `startswith` and `endswith` in string 394 | I'd like to add `take` and `drop`, implemented with sub, to the List object. 395 | The `functional.id` function should be renamed to `identity` 396 | The `functional.fold` should be renamed to reduce, correctly supporting the optional start arg (otherwise, use the first value of the iterator) 397 | Add `range` to functional namespace. Add `dir` to debug - update `dir` to prettyprint. Add multimethods. 398 | We should also add in [LPeg](https://github.com/lua/lpeg) - which will also give me a first class Pattern object (and a powerful pattern system) 399 | Remove stdlib's Trees, Use Terra's notion of trees (which it also refers to as tuples, because they're used with structs) 400 | Replace Terra's list with the new List, rename to TableList 401 | Accept the code clone on memoize - it can be refactored later if it matters 402 | Minify the entire file. (to make the executable smaller) 403 | 404 | In CLJS Compilation, use [LuaJIT's compiler](http://luajit.org/running.html) in place of Closure. 405 | It will do deadcode elimination and other optimizations, outputting a bytecode file that should run with the Terra executable. 406 | We just need to compile with optimizations on... just like the Closure Compiler. 407 | 408 | Also, there are [modifications to Lua](http://www.orocos.org/wiki/orocos/toolchain/luacookbook), 409 | which allow it to be used for hard real-time computation. I also found [EEL](http://eel.olofson.net/) - a scripting language, 410 | in the spirit of Lua, with prototypical OO, exceptions, and specificially built for hard real-time systems (audio and control). 411 | 412 | 413 | (Feb 9, 2014) 414 | As I was reading more about Lua [OO benchmarks](http://lua-users.org/wiki/ObjectBenchmarkTests) 415 | and determining if an IO system could be placed upon Lua(JIT), I stumbled upon 416 | the [Potion Language](https://github.com/perl11/potion) - taking the ideas of 417 | Lua and IO and placing them upon a highly modified LuaJIT. After some serious 418 | investigation I still think the above approach is the best fit. 419 | 420 | (Feb 16, 2014) 421 | You should keep an eye on [terra-utils](https://github.com/dritchie/terra-utils). 422 | Also look at Daniel Ritchie's other probability things: [Stan-inspired Terra-ad](https://github.com/dritchie/terra-ad) - 423 | which includes a simple memory pool system, and [quicksand](https://github.com/dritchie/quicksand) - 424 | probability programming for Terra 425 | 426 | Just a recap of the data structures by "tier". 427 | Only the highest tier (as it appears in the CLJS tooling) supports a 428 | fully-unified interop across all tier structures 429 | 430 | #### Low-level, typed 431 | At this tier, code is targeting LLVM compilation and everything is typed. 432 | Mutability is default, and there is no memory safety. 433 | 434 | * Dict (to be written, based on HMap [here](https://github.com/dritchie/terra-utils) 435 | * Array 436 | * Vector (this is special-purposed for SIMD; it's namespaced to avoid clashing) 437 | * Struct 438 | 439 | Dispatch is: 440 | * Function call 441 | * Interfaces (Go-like/protocol-like dispatch) 442 | 443 | #### Environment, dynamic 444 | At this tier, code is dynamic and part of an active runtime (LuaJIT). 445 | This code is used for low-level generation, or the foundation for a dynamic 446 | application. Mutability is the default, there is memory safety. Exception 447 | handling is [protective calls](http://www.lua.org/pil/8.4.html), signaling, and recovery. 448 | 449 | * Table 450 | * TableList 451 | * Tree 452 | * Container (an object with no properties, only functions) 453 | * Object (a prototypical object; uses Lua's OO metatables pattern) 454 | * Peg (an LPeg pattern Object) 455 | 456 | Dispatch is: 457 | * Function call 458 | * Multimethods without hierarchies 459 | 460 | #### Runtime, dynamic 461 | At this tier, code is compiled AOT to target the lower two tiers (environment 462 | and low-level). This tier is very high level and extensible. It champions 463 | simplistic systems, functional programming, immutability, and memory safety 464 | by default. There is full and extensible exception handling. Code here 465 | generates Environment and Low-level code. 466 | 467 | * Map 468 | * List 469 | * Vector 470 | * ArrayMap 471 | * Set 472 | * Record 473 | 474 | Dispatch is: 475 | * Function call 476 | * Multimethods with hierarchies 477 | * Protocols 478 | * core.match-based 479 | 480 | #### Latest 481 | 482 | (Feb 23, 2014) 483 | I got curious about various approaches to threads, threadpools, and async I/O 484 | that could work well in Lua, where Lua doesn't impose a lock (GIL or otherwise), 485 | but where you'd want to keep sanity intact. 486 | 487 | The obvious (historical) start was to investigate Coro and Libev, which quickly 488 | gave way to libuv (the library behind Node.js and currently also what powers 489 | Rust's tasks). 490 | 491 | The problem I wanted to avoid was callbacks everywhere, although that could be 492 | somewhat undone with CSP. 493 | 494 | I found Richard Hundt's Luv (libuv wrappers) which included OS threads and 495 | bundled ZeroMQ for inter-thread communication. When I was previously talking 496 | with Timothy Baldridge, we agreed a message-passing thread communication was the 497 | only safe model (unless I wanted to take the [Lua Wiki advice](http://lua-users.org/wiki/ThreadsTutorial) and add a lock 498 | to the system, essentially killing the true threading). 499 | Luv has the benefit of being integrated into Lua's coroutines, so everything 500 | feels more like CSP than callbacks-and-pull-oriented. This is a natural fit 501 | and one that fits the programming model. 502 | 503 | Richard removed the ZeroMQ dependency, slimmed the package down, removed threads, 504 | processes, streamed-stdin/stdout/stderr, and a other few things, 505 | and released it as [Ray](https://github.com/richardhundt/ray) to avoid naming 506 | confusion from another Lua libuv wrapper from the luvit guy, [luv](https://github.com/creationix/luv). 507 | That particular luv is a direct wrap of the libuv stuff. 508 | 509 | Ray nicely provides fibers (green threads), which look exactly like you'd expect. 510 | 511 | I don't necessarily want OS threads directly, I want a worker queue backed by 512 | OS Threads, and I want "jobing" to perform more like Futures (as found in Clojure). 513 | I think this is possible if threads in the threadpool always get a new 514 | Terra/Lua state, or get a copy/clone of the current Lua/Terra state at the moment 515 | of dispatch. The open question is, how expensive is the State copy, and how often 516 | do futures really need to reference something (global state) that exists in the 517 | current environment? As a first attempt of adding libuv's worker queue into 518 | Ray, I might try only New States (or passed in lua tables), where the queue submission returns a wrapped 519 | fiber that handles yielding and resuming with the main loop correctly, and 520 | has a ".result()" function, that does a ".join()" call under the hood. 521 | 522 | The tradeoff here is that in order to use the concurrency/async stuff, you *always* 523 | have to accept that the libuv loop will be running under the hood. 524 | Another tradeoff is that this still doesn't satisfy running `core.async`'s 525 | state machines in parallel (at least no solution that is immediate to me right 526 | now). The core.async + fibers could be confusing (different systems at different 527 | levels with slightly-different-but-very-close semantics). 528 | Terra also has no issue with using pthreads directly, so building an executor 529 | pool at that level is an option, but this puts incredible strain on what you 530 | can do in Terra for AOT/generated code and what you can do during LuaJIT runtime 531 | stuff. It's nice having all the socket stuff provided (I think I'd have to roll 532 | in Unix Domain Sockets) it means using only fibers at the core when using them 533 | directly. Perhaps this can be remedied a little by tucking it all under an 534 | `async` module as the original design doc suggested. 535 | 536 | 537 | -------------------------------------------------------------------------------- /epl-v10.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 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojurescript-terra "0.1.0-SNAPSHOT" 2 | :description "ClojureScript running on Terra" 3 | :url "https://github.com/ohpauleez/cljs-terra" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.6.0-beta1"] 7 | [org.clojure/clojurescript "0.0-2156" :exlusions [org.clojure/tools.reader]] 8 | [org.clojure/tools.reader "0.8.3"] 9 | [org.clojure/data.json "0.2.4"] 10 | ;; Experiment with mapping an EDN AST, to a Terra.list AST, 11 | ;; then using the Terra language/compiler tooling 12 | [org.clojure/tools.analyzer "0.1.0-beta4"]]) 13 | 14 | -------------------------------------------------------------------------------- /src/cljs/terra/compiler.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 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 | ; Additions and Updates made by Paul deGrandis 10 | 11 | (ns cljs.terra.compiler 12 | (:refer-clojure :exclude [munge macroexpand-1]) 13 | (:require [clojure.java.io :as io] 14 | [clojure.string :as string] 15 | [clojure.tools.reader :as reader] 16 | [cljs.env :as env] 17 | [cljs.tagged-literals :as tags] 18 | [cljs.terra.analyzer :as ana] 19 | ;; There is source-mapping currently for Lua 20 | ;; This is left in, but will always be ignored during compilation 21 | [cljs.source-map :as sm]) 22 | (:import java.lang.StringBuilder 23 | java.io.File)) 24 | 25 | (set! *warn-on-reflection* true) 26 | 27 | ;; next line is auto-generated by the build-script - Do not edit! 28 | (def ^:dynamic *clojurescript-version*) 29 | (def ^:dynamic *cljsterra-version*) 30 | 31 | (defn cljsterra-version 32 | "Returns clojurescript terra version as a printable string." 33 | [] 34 | (str 35 | (:major *cljsterra-version*) 36 | "." 37 | (:minor *cljsterra-version*) 38 | (when-let [i (:incremental *cljsterra-version*)] 39 | (str "." i)) 40 | (when-let [q (:qualifier *cljsterra-version*)] 41 | (str "-" q)) 42 | (when (:interim *cljsterra-version*) 43 | "-SNAPSHOT")) ) 44 | 45 | (defn clojurescript-version 46 | "Returns clojurescript version as a printable string." 47 | [] 48 | (str 49 | (:major *clojurescript-version*) 50 | "." 51 | (:minor *clojurescript-version*) 52 | (when-let [i (:incremental *clojurescript-version*)] 53 | (str "." i)) 54 | (when-let [q (:qualifier *clojurescript-version*)] 55 | (str "-" q)) 56 | (when (:interim *clojurescript-version*) 57 | "-SNAPSHOT"))) 58 | 59 | (def terra-reserved 60 | #{"and" "break" "do" "else" "elseif" "end" "for" 61 | "function" "if" "local" "nil" "not" "or" "repeat" "return" "then" 62 | "until" "while" "bit" "var" "struct" "union" "goto" 63 | "int" "int8" "int16" "int32" "int64" 64 | "uint" "uint8" "uint16" "uint32" "uint64" 65 | "float" "double" "bool"}) 66 | 67 | (def ^:dynamic *source-map-data* nil) 68 | (def ^:dynamic *lexical-renames* {}) 69 | 70 | (def cljs-reserved-file-names #{"deps.cljs"}) 71 | 72 | (defmacro ^:private debug-prn 73 | [& args] 74 | `(.println System/err (str ~@args))) 75 | 76 | (defn ns-first-segments [] 77 | (letfn [(get-first-ns-segment [ns] (first (string/split (str ns) #"\.")))] 78 | (map get-first-ns-segment (keys (::ana/namespaces @env/*compiler*))))) 79 | 80 | ; Helper fn 81 | (defn shadow-depth [s] 82 | (let [{:keys [name info]} s] 83 | (loop [d 0, {:keys [shadow]} info] 84 | (cond 85 | shadow (recur (inc d) shadow) 86 | (some #{(str name)} (ns-first-segments)) (inc d) 87 | :else d)))) 88 | 89 | (defn munge 90 | ([s] (munge s lua-reserved)) 91 | ([s reserved] 92 | (if (map? s) 93 | ; Unshadowing 94 | (let [{:keys [name field] :as info} s 95 | depth (shadow-depth s) 96 | renamed (*lexical-renames* (System/identityHashCode s)) 97 | munged-name (munge (cond field (str "self__." name) 98 | renamed renamed 99 | :else name) 100 | reserved)] 101 | (if (or field (zero? depth)) 102 | munged-name 103 | (symbol (str munged-name "__$" depth)))) 104 | ; String munging 105 | (let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special 106 | ss (apply str (map #(if (reserved %) (str % "$") %) 107 | (string/split ss #"(?<=\.)|(?=\.)"))) 108 | ms (clojure.lang.Compiler/munge ss)] 109 | (if (symbol? s) 110 | (symbol ms) 111 | ms))))) 112 | 113 | (defn- comma-sep [xs] 114 | (interpose "," xs)) 115 | 116 | (defn- escape-char [^Character c] 117 | (let [cp (.hashCode c)] 118 | (case cp 119 | ; Handle printable escapes before ASCII 120 | 34 "\\\"" 121 | 92 "\\\\" 122 | ; Handle non-printable escapes 123 | 8 "\\b" 124 | 12 "\\f" 125 | 10 "\\n" 126 | 13 "\\r" 127 | 9 "\\t" 128 | (if (< 31 cp 127) 129 | c ; Print simple ASCII characters 130 | (format "\\u%04X" cp))))) ; Any other character is Unicode 131 | 132 | (defn- escape-string [^CharSequence s] 133 | (let [sb (StringBuilder. (count s))] 134 | (doseq [c s] 135 | (.append sb (escape-char c))) 136 | (.toString sb))) 137 | 138 | (defn- wrap-in-double-quotes [x] 139 | (str \" x \")) 140 | 141 | (defmulti emit* :op) 142 | 143 | (defn emit [ast] 144 | (env/ensure 145 | (when *source-map-data* 146 | (let [{:keys [env]} ast] 147 | (when (:line env) 148 | (let [{:keys [line column]} env] 149 | (swap! *source-map-data* 150 | (fn [m] 151 | (let [minfo (cond-> {:gcol (:gen-col m) 152 | :gline (:gen-line m)} 153 | (= (:op ast) :var) 154 | (assoc :name (str (-> ast :info :name))))] 155 | ; Dec the line/column numbers for 0-indexing. 156 | ; tools.reader uses 1-indexed sources, chrome 157 | ; expects 0-indexed source maps. 158 | (update-in m [:source-map (dec line)] 159 | (fnil (fn [line] 160 | (update-in line [(if column (dec column) 0)] 161 | (fnil (fn [column] (conj column minfo)) []))) 162 | (sorted-map)))))))))) 163 | (emit* ast))) 164 | 165 | (defn emits [& xs] 166 | (doseq [x xs] 167 | (cond 168 | (nil? x) nil 169 | (map? x) (emit x) 170 | (seq? x) (apply emits x) 171 | (fn? x) (x) 172 | :else (let [s (print-str x)] 173 | (when *source-map-data* 174 | (swap! *source-map-data* 175 | update-in [:gen-col] #(+ % (count s)))) 176 | (print s)))) 177 | nil) 178 | 179 | (defn emitln [& xs] 180 | (apply emits xs) 181 | (println) 182 | (when *source-map-data* 183 | (swap! *source-map-data* 184 | (fn [{:keys [gen-line] :as m}] 185 | (assoc m 186 | :gen-line (inc gen-line) 187 | :gen-col 0)))) 188 | nil) 189 | 190 | (defn ^String emit-str [expr] 191 | (with-out-str (emit expr))) 192 | 193 | (defmulti emit-constant class) 194 | (defmethod emit-constant nil [x] (emits "nil")) 195 | (defmethod emit-constant Long [x] (emits x)) 196 | (defmethod emit-constant Integer [x] (emits x)) ; reader puts Integers in metadata 197 | (defmethod emit-constant Double [x] (emits x)) 198 | (defmethod emit-constant String [x] 199 | (emits "(" (wrap-in-double-quotes (escape-string x)) ")")) 200 | (defmethod emit-constant Boolean [x] (emits (if x "true" "false"))) 201 | (defmethod emit-constant Character [x] 202 | (emits (wrap-in-double-quotes (escape-char x)))) 203 | 204 | ;; All strings in lua can be used to match 205 | (defmethod emit-constant java.util.regex.Pattern [x] 206 | (let [[_ flags pattern] (re-find #"^(?:\(\?(x[idmsux]*)\))?(.*)" (str x))] 207 | (emits \/ (.replaceAll (re-matcher #"/" pattern) "\\\\/") \/ flags))) 208 | 209 | (def ^:const goog-hash-max 0x100000000) 210 | 211 | (defn goog-string-hash [s] 212 | (reduce 213 | (fn [r c] 214 | (mod (+ (* 31 r) (int c)) goog-hash-max)) 215 | 0 s)) 216 | 217 | (defmethod emit-constant clojure.lang.Keyword [x] 218 | (if (-> @env/*compiler* :opts :emit-constants) 219 | (let [value (-> @env/*compiler* ::ana/constant-table x)] 220 | (emits "cljs.core." value)) 221 | (let [ns (namespace x) 222 | name (name x)] 223 | (emits "new cljs.core.Keyword(") 224 | (emit-constant ns) 225 | (emits ",") 226 | (emit-constant name) 227 | (emits ",") 228 | (emit-constant (if ns 229 | (str ns "/" name) 230 | name)) 231 | (emits ",") 232 | (emit-constant (+ (clojure.lang.Util/hashCombine 233 | (unchecked-int (goog-string-hash ns)) 234 | (unchecked-int (goog-string-hash name))) 235 | 0x9e3779b9)) 236 | (emits ")")))) 237 | 238 | (defmethod emit-constant clojure.lang.Symbol [x] 239 | (let [ns (namespace x) 240 | name (name x) 241 | symstr (if-not (nil? ns) 242 | (str ns "/" name) 243 | name)] 244 | (emits "new cljs.core.Symbol(") 245 | (emit-constant ns) 246 | (emits ",") 247 | (emit-constant name) 248 | (emits ",") 249 | (emit-constant symstr) 250 | (emits ",") 251 | (emit-constant (clojure.lang.Util/hashCombine 252 | (unchecked-int (goog-string-hash ns)) 253 | (unchecked-int (goog-string-hash name)))) 254 | (emits ",") 255 | (emit-constant nil) 256 | (emits ")"))) 257 | 258 | ;; tagged literal support 259 | 260 | (defmethod emit-constant java.util.Date [^java.util.Date date] 261 | (emits "new Date(" (.getTime date) ")")) 262 | 263 | (defmethod emit-constant java.util.UUID [^java.util.UUID uuid] 264 | (emits "new cljs.core.UUID(\"" (.toString uuid) "\")")) 265 | 266 | (defmacro emit-wrap [env & body] 267 | `(let [env# ~env] 268 | (when (= :return (:context env#)) (emits "return ")) 269 | ~@body 270 | (when-not (= :expr (:context env#)) (emitln ";")))) 271 | 272 | (defmethod emit* :no-op [m]) 273 | 274 | (defmethod emit* :var 275 | [{:keys [info env] :as arg}] 276 | (let [var-name (:name info) 277 | info (if (= (namespace var-name) "js") 278 | (name var-name) 279 | info)] 280 | ; We need a way to write bindings out to source maps and javascript 281 | ; without getting wrapped in an emit-wrap calls, otherwise we get 282 | ; e.g. (function greet(return x, return y) {}). 283 | (if (:binding-form? arg) 284 | ; Emit the arg map so shadowing is properly handled when munging 285 | ; (prevents duplicate fn-param-names) 286 | (emits (munge arg)) 287 | (when-not (= :statement (:context env)) 288 | (emit-wrap env (emits (munge info))))))) 289 | 290 | (defmethod emit* :meta 291 | [{:keys [expr meta env]}] 292 | (emit-wrap env 293 | (emits "cljs.core.with_meta(" expr "," meta ")"))) 294 | 295 | (def ^:private array-map-threshold 8) 296 | (def ^:private obj-map-threshold 8) 297 | 298 | (defn distinct-keys? [keys] 299 | (and (every? #(= (:op %) :constant) keys) 300 | (= (count (into #{} keys)) (count keys)))) 301 | 302 | (defmethod emit* :map 303 | [{:keys [env keys vals]}] 304 | (let [simple-keys? (every? #(or (string? %) (keyword? %)) keys)] 305 | (emit-wrap env 306 | (cond 307 | (zero? (count keys)) 308 | (emits "cljs.core.PersistentArrayMap.EMPTY") 309 | 310 | (<= (count keys) array-map-threshold) 311 | (if (distinct-keys? keys) 312 | (emits "new cljs.core.PersistentArrayMap(null, " (count keys) ", [" 313 | (comma-sep (interleave keys vals)) 314 | "], null)") 315 | (emits "new cljs.core.PersistentArrayMap.fromArray([" 316 | (comma-sep (interleave keys vals)) 317 | "], true, false)")) 318 | 319 | :else 320 | (emits "cljs.core.PersistentHashMap.fromArrays([" 321 | (comma-sep keys) 322 | "],[" 323 | (comma-sep vals) 324 | "])"))))) 325 | 326 | (defmethod emit* :list 327 | [{:keys [items env]}] 328 | (emit-wrap env 329 | (if (empty? items) 330 | (emits "cljs.core.List.EMPTY") 331 | (emits "cljs.core.list(" (comma-sep items) ")")))) 332 | 333 | (defmethod emit* :vector 334 | [{:keys [items env]}] 335 | (emit-wrap env 336 | (if (empty? items) 337 | (emits "cljs.core.PersistentVector.EMPTY") 338 | (let [cnt (count items)] 339 | (if (< cnt 32) 340 | (emits "new cljs.core.PersistentVector(null, " cnt 341 | ", 5, cljs.core.PersistentVector.EMPTY_NODE, [" (comma-sep items) "], null)") 342 | (emits "cljs.core.PersistentVector.fromArray([" (comma-sep items) "], true)")))))) 343 | 344 | (defn distinct-constants? [items] 345 | (and (every? #(= (:op %) :constant) items) 346 | (= (count (into #{} items)) (count items)))) 347 | 348 | (defmethod emit* :set 349 | [{:keys [items env]}] 350 | (emit-wrap env 351 | (cond 352 | (empty? items) 353 | (emits "cljs.core.PersistentHashSet.EMPTY") 354 | 355 | (distinct-constants? items) 356 | (emits "new cljs.core.PersistentHashSet(null, new cljs.core.PersistentArrayMap(null, " (count items) ", [" 357 | (comma-sep (interleave items (repeat "null"))) "], null), null)") 358 | 359 | :else (emits "cljs.core.PersistentHashSet.fromArray([" (comma-sep items) "], true)")))) 360 | 361 | (defmethod emit* :host-value 362 | [{:keys [items host-type env]}] 363 | (emit-wrap env 364 | (if (= host-type :object) 365 | (do 366 | (emits "{") 367 | (when-let [items (seq items)] 368 | (let [[[k v] & r] items] 369 | (emits "\"" (name k) "\": " v) 370 | (doseq [[k v] r] 371 | (emits ", \"" (name k) "\": " v)))) 372 | (emits "}")) 373 | (emits "[" (comma-sep items) "]")))) 374 | 375 | (defmethod emit* :constant 376 | [{:keys [form env]}] 377 | (when-not (= :statement (:context env)) 378 | (emit-wrap env (emit-constant form)))) 379 | 380 | (defn safe-test? [env e] 381 | (let [tag (ana/infer-tag env e)] 382 | (or (#{'boolean 'seq} tag) 383 | (when (= (:op e) :constant) 384 | (let [form (:form e)] 385 | (not (or (and (string? form) (= form "")) 386 | (and (number? form) (zero? form))))))))) 387 | 388 | (defmethod emit* :if 389 | [{:keys [test then else env unchecked]}] 390 | (let [context (:context env) 391 | checked (not (or unchecked (safe-test? env test)))] 392 | (if (= :expr context) 393 | (emits "(" (when checked "cljs.core.truth_") "(" test ")?" then ":" else ")") 394 | (do 395 | (if checked 396 | (emitln "if(cljs.core.truth_(" test "))") 397 | (emitln "if(" test ")")) 398 | (emitln "{" then "} else") 399 | (emitln "{" else "}"))))) 400 | 401 | (defmethod emit* :throw 402 | [{:keys [throw env]}] 403 | (if (= :expr (:context env)) 404 | (emits "(function(){throw " throw "})()") 405 | (emitln "throw " throw ";"))) 406 | 407 | (defn emit-comment 408 | "Emit a nicely formatted comment string." 409 | [doc jsdoc] 410 | (let [docs (when doc [doc]) 411 | docs (if jsdoc (concat docs jsdoc) docs) 412 | docs (remove nil? docs)] 413 | (letfn [(print-comment-lines [e] (doseq [next-line (string/split-lines e)] 414 | (emitln "* " (string/trim next-line))))] 415 | (when (seq docs) 416 | (emitln "/**") 417 | (doseq [e docs] 418 | (when e 419 | (print-comment-lines e))) 420 | (emitln "*/"))))) 421 | 422 | (defmethod emit* :def 423 | [{:keys [name var init env doc export]}] 424 | (let [mname (munge name)] 425 | (when init 426 | (emit-comment doc (:fndoc init)) 427 | (emits var) 428 | (emits " = " init) 429 | ;; NOTE: JavaScriptCore does not like this under advanced compilation 430 | ;; this change was primarily for REPL interactions - David 431 | ;(emits " = (typeof " mname " != 'undefined') ? " mname " : undefined") 432 | (when-not (= :expr (:context env)) (emitln ";")) 433 | (when export 434 | (emitln "goog.exportSymbol('" (munge export) "', " mname ");"))))) 435 | 436 | (defn emit-apply-to 437 | [{:keys [name params env]}] 438 | (let [arglist (gensym "arglist__") 439 | delegate-name (str (munge name) "__delegate")] 440 | (emitln "(function (" arglist "){") 441 | (doseq [[i param] (map-indexed vector (drop-last 2 params))] 442 | (emits "var ") 443 | (emit param) 444 | (emits " = cljs.core.first(") 445 | (emitln arglist ");") 446 | (emitln arglist " = cljs.core.next(" arglist ");")) 447 | (if (< 1 (count params)) 448 | (do 449 | (emits "var ") 450 | (emit (last (butlast params))) 451 | (emitln " = cljs.core.first(" arglist ");") 452 | (emits "var ") 453 | (emit (last params)) 454 | (emitln " = cljs.core.rest(" arglist ");") 455 | (emits "return " delegate-name "(") 456 | (doseq [param params] 457 | (emit param) 458 | (when-not (= param (last params)) (emits ","))) 459 | (emitln ");")) 460 | (do 461 | (emits "var ") 462 | (emit (last params)) 463 | (emitln " = cljs.core.seq(" arglist ");") 464 | (emits "return " delegate-name "(") 465 | (doseq [param params] 466 | (emit param) 467 | (when-not (= param (last params)) (emits ","))) 468 | (emitln ");"))) 469 | (emits "})"))) 470 | 471 | (defn emit-fn-params [params] 472 | (doseq [param params] 473 | (emit param) 474 | ; Avoid extraneous comma (function greet(x, y, z,) 475 | (when-not (= param (last params)) 476 | (emits ",")))) 477 | 478 | (defn emit-fn-method 479 | [{:keys [type name variadic params expr env recurs max-fixed-arity]}] 480 | (emit-wrap env 481 | (emits "(function " (munge name) "(") 482 | (emit-fn-params params) 483 | (emits "){") 484 | (when type 485 | (emitln "var self__ = this;")) 486 | (when recurs (emitln "while(true){")) 487 | (emits expr) 488 | (when recurs 489 | (emitln "break;") 490 | (emitln "}")) 491 | (emits "})"))) 492 | 493 | (defn emit-variadic-fn-method 494 | [{:keys [type name variadic params expr env recurs max-fixed-arity] :as f}] 495 | (emit-wrap env 496 | (let [name (or name (gensym)) 497 | mname (munge name) 498 | delegate-name (str mname "__delegate")] 499 | (emitln "(function() { ") 500 | (emits "var " delegate-name " = function (") 501 | (doseq [param params] 502 | (emit param) 503 | (when-not (= param (last params)) (emits ","))) 504 | (emits "){") 505 | (when recurs (emitln "while(true){")) 506 | (emits expr) 507 | (when recurs 508 | (emitln "break;") 509 | (emitln "}")) 510 | (emitln "};") 511 | 512 | (emitln "var " mname " = function (" (comma-sep 513 | (if variadic 514 | (concat (butlast params) ['var_args]) 515 | params)) "){") 516 | (when type 517 | (emitln "var self__ = this;")) 518 | (when variadic 519 | (emits "var ") 520 | (emit (last params)) 521 | (emits " = null;") 522 | (emitln "if (arguments.length > " (dec (count params)) ") {") 523 | (emits " ") 524 | (emit (last params)) 525 | (emits " = cljs.core.array_seq(Array.prototype.slice.call(arguments, " (dec (count params)) "),0);") 526 | (emitln "} ")) 527 | (emits "return " delegate-name ".call(this,") 528 | (doseq [param params] 529 | (emit param) 530 | (when-not (= param (last params)) (emits ","))) 531 | (emits ");") 532 | (emitln "};") 533 | 534 | (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";") 535 | (emits mname ".cljs$lang$applyTo = ") 536 | (emit-apply-to (assoc f :name name)) 537 | (emitln ";") 538 | (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " delegate-name ";") 539 | (emitln "return " mname ";") 540 | (emitln "})()")))) 541 | 542 | (defmethod emit* :fn 543 | [{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}] 544 | ;;fn statements get erased, serve no purpose and can pollute scope if named 545 | (when-not (= :statement (:context env)) 546 | (let [loop-locals (->> (concat (mapcat :params (filter #(and % @(:flag %)) recur-frames)) 547 | (mapcat :params loop-lets)) 548 | (map munge) 549 | seq)] 550 | (when loop-locals 551 | (when (= :return (:context env)) 552 | (emits "return ")) 553 | (emitln "((function (" (comma-sep (map munge loop-locals)) "){") 554 | (when-not (= :return (:context env)) 555 | (emits "return "))) 556 | (if (= 1 (count methods)) 557 | (if variadic 558 | (emit-variadic-fn-method (assoc (first methods) :name name)) 559 | (emit-fn-method (assoc (first methods) :name name))) 560 | (let [has-name? (and name true) 561 | name (or name (gensym)) 562 | mname (munge name) 563 | maxparams (apply max-key count (map :params methods)) 564 | mmap (into {} 565 | (map (fn [method] 566 | [(munge (symbol (str mname "__" (count (:params method))))) 567 | method]) 568 | methods)) 569 | ms (sort-by #(-> % second :params count) (seq mmap))] 570 | (when (= :return (:context env)) 571 | (emits "return ")) 572 | (emitln "(function() {") 573 | (emitln "var " mname " = null;") 574 | (doseq [[n meth] ms] 575 | (emits "var " n " = ") 576 | (if (:variadic meth) 577 | (emit-variadic-fn-method meth) 578 | (emit-fn-method meth)) 579 | (emitln ";")) 580 | (emitln mname " = function(" (comma-sep (if variadic 581 | (concat (butlast maxparams) ['var_args]) 582 | maxparams)) "){") 583 | (when variadic 584 | (emits "var ") 585 | (emit (last maxparams)) 586 | (emitln " = var_args;")) 587 | (emitln "switch(arguments.length){") 588 | (doseq [[n meth] ms] 589 | (if (:variadic meth) 590 | (do (emitln "default:") 591 | (emitln "return " n ".cljs$core$IFn$_invoke$arity$variadic(" 592 | (comma-sep (butlast maxparams)) 593 | (when (> (count maxparams) 1) ", ") 594 | "cljs.core.array_seq(arguments, " max-fixed-arity "));")) 595 | (let [pcnt (count (:params meth))] 596 | (emitln "case " pcnt ":") 597 | (emitln "return " n ".call(this" (if (zero? pcnt) nil 598 | (list "," (comma-sep (take pcnt maxparams)))) ");")))) 599 | (emitln "}") 600 | (emitln "throw(new Error('Invalid arity: ' + arguments.length));") 601 | (emitln "};") 602 | (when variadic 603 | (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";") 604 | (emitln mname ".cljs$lang$applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) ".cljs$lang$applyTo;")) 605 | (when has-name? 606 | (doseq [[n meth] ms] 607 | (let [c (count (:params meth))] 608 | (if (:variadic meth) 609 | (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " n ".cljs$core$IFn$_invoke$arity$variadic;") 610 | (emitln mname ".cljs$core$IFn$_invoke$arity$" c " = " n ";"))))) 611 | (emitln "return " mname ";") 612 | (emitln "})()"))) 613 | (when loop-locals 614 | (emitln ";})(" (comma-sep loop-locals) "))"))))) 615 | 616 | (defmethod emit* :do 617 | [{:keys [statements ret env]}] 618 | (let [context (:context env)] 619 | (when (and statements (= :expr context)) (emits "(function (){")) 620 | (when statements 621 | (emits statements)) 622 | (emit ret) 623 | (when (and statements (= :expr context)) (emits "})()")))) 624 | 625 | (defmethod emit* :try 626 | [{:keys [env try catch name finally]}] 627 | (let [context (:context env)] 628 | (if (or name finally) 629 | (do 630 | (when (= :expr context) 631 | (emits "(function (){")) 632 | (emits "try{" try "}") 633 | (when name 634 | (emits "catch (" (munge name) "){" catch "}")) 635 | (when finally 636 | (assert (not= :constant (:op finally)) "finally block cannot contain constant") 637 | (emits "finally {" finally "}")) 638 | (when (= :expr context) 639 | (emits "})()"))) 640 | (emits try)))) 641 | 642 | (defn emit-let 643 | [{:keys [bindings expr env]} is-loop] 644 | (let [context (:context env)] 645 | (when (= :expr context) (emits "(function (){")) 646 | (binding [*lexical-renames* (into *lexical-renames* 647 | (when (= :statement context) 648 | (map #(vector (System/identityHashCode %) 649 | (gensym (str (:name %) "-"))) 650 | bindings)))] 651 | (doseq [{:keys [init] :as binding} bindings] 652 | (emits "var ") 653 | (emit binding) ; Binding will be treated as a var 654 | (emits " = " init ";")) 655 | (when is-loop (emitln "while(true){")) 656 | (emits expr) 657 | (when is-loop 658 | (emitln "break;") 659 | (emitln "}"))) 660 | (when (= :expr context) (emits "})()")))) 661 | 662 | (defmethod emit* :let [ast] 663 | (emit-let ast false)) 664 | 665 | (defmethod emit* :loop [ast] 666 | (emit-let ast true)) 667 | 668 | (defmethod emit* :recur 669 | [{:keys [frame exprs env]}] 670 | (let [temps (vec (take (count exprs) (repeatedly gensym))) 671 | params (:params frame)] 672 | (emitln "{") 673 | (dotimes [i (count exprs)] 674 | (emitln "var " (temps i) " = " (exprs i) ";")) 675 | (dotimes [i (count exprs)] 676 | (emitln (munge (params i)) " = " (temps i) ";")) 677 | (emitln "continue;") 678 | (emitln "}"))) 679 | 680 | (defmethod emit* :letfn 681 | [{:keys [bindings expr env]}] 682 | (let [context (:context env)] 683 | (when (= :expr context) (emits "(function (){")) 684 | (doseq [{:keys [init] :as binding} bindings] 685 | (emitln "var " (munge binding) " = " init ";")) 686 | (emits expr) 687 | (when (= :expr context) (emits "})()")))) 688 | 689 | (defn protocol-prefix [psym] 690 | (symbol (str (-> (str psym) (.replace \. \$) (.replace \/ \$)) "$"))) 691 | 692 | (defmethod emit* :invoke 693 | [{:keys [f args env] :as expr}] 694 | (let [info (:info f) 695 | fn? (and ana/*cljs-static-fns* 696 | (not (:dynamic info)) 697 | (:fn-var info)) 698 | protocol (:protocol info) 699 | tag (ana/infer-tag env (first (:args expr))) 700 | proto? (and protocol tag 701 | (or (and ana/*cljs-static-fns* protocol (= tag 'not-native)) 702 | (and 703 | (or ana/*cljs-static-fns* 704 | (:protocol-inline env)) 705 | (or (= protocol tag) 706 | ;; ignore new type hints for now - David 707 | (and (not (set? tag)) 708 | (not ('#{any clj clj-or-nil} tag)) 709 | (when-let [ps (:protocols (ana/resolve-existing-var (dissoc env :locals) tag))] 710 | (ps protocol))))))) 711 | opt-not? (and (= (:name info) 'cljs.core/not) 712 | (= (ana/infer-tag env (first (:args expr))) 'boolean)) 713 | ns (:ns info) 714 | js? (= ns 'js) 715 | goog? (when ns 716 | (or (= ns 'goog) 717 | (when-let [ns-str (str ns)] 718 | (= (get (string/split ns-str #"\.") 0 nil) "goog")))) 719 | keyword? (and (= (-> f :op) :constant) 720 | (keyword? (-> f :form))) 721 | [f variadic-invoke] 722 | (if fn? 723 | (let [arity (count args) 724 | variadic? (:variadic info) 725 | mps (:method-params info) 726 | mfa (:max-fixed-arity info)] 727 | (cond 728 | ;; if only one method, no renaming needed 729 | (and (not variadic?) 730 | (= (count mps) 1)) 731 | [f nil] 732 | 733 | ;; direct dispatch to variadic case 734 | (and variadic? (> arity mfa)) 735 | [(update-in f [:info :name] 736 | (fn [name] (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$variadic")))) 737 | {:max-fixed-arity mfa}] 738 | 739 | ;; direct dispatch to specific arity case 740 | :else 741 | (let [arities (map count mps)] 742 | (if (some #{arity} arities) 743 | [(update-in f [:info :name] 744 | (fn [name] (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$" arity)))) nil] 745 | [f nil])))) 746 | [f nil])] 747 | (emit-wrap env 748 | (cond 749 | opt-not? 750 | (emits "!(" (first args) ")") 751 | 752 | proto? 753 | (let [pimpl (str (munge (protocol-prefix protocol)) 754 | (munge (name (:name info))) "$arity$" (count args))] 755 | (emits (first args) "." pimpl "(" (comma-sep (cons "null" (rest args))) ")")) 756 | 757 | keyword? 758 | (emits f ".cljs$core$IFn$_invoke$arity$" (count args) "(" (comma-sep args) ")") 759 | 760 | variadic-invoke 761 | (let [mfa (:max-fixed-arity variadic-invoke)] 762 | (emits f "(" (comma-sep (take mfa args)) 763 | (when-not (zero? mfa) ",") 764 | "cljs.core.array_seq([" (comma-sep (drop mfa args)) "], 0))")) 765 | 766 | (or fn? js? goog?) 767 | (emits f "(" (comma-sep args) ")") 768 | 769 | :else 770 | (if (and ana/*cljs-static-fns* (= (:op f) :var)) 771 | (let [fprop (str ".cljs$core$IFn$_invoke$arity$" (count args))] 772 | (emits "(" f fprop " ? " f fprop "(" (comma-sep args) ") : " f ".call(" (comma-sep (cons "null" args)) "))")) 773 | (emits f ".call(" (comma-sep (cons "null" args)) ")")))))) 774 | 775 | (defmethod emit* :new 776 | [{:keys [ctor args env]}] 777 | (emit-wrap env 778 | (emits "(new " ctor "(" 779 | (comma-sep args) 780 | "))"))) 781 | 782 | (defmethod emit* :set! 783 | [{:keys [target val env]}] 784 | (emit-wrap env (emits target " = " val))) 785 | 786 | (defmethod emit* :ns 787 | [{:keys [name requires uses require-macros env]}] 788 | (emitln "goog.provide('" (munge name) "');") 789 | (when-not (= name 'cljs.core) 790 | (emitln "goog.require('cljs.core');")) 791 | (doseq [lib (into (vals requires) (distinct (vals uses)))] 792 | (emitln "goog.require('" (munge lib) "');"))) 793 | 794 | (defmethod emit* :deftype* 795 | [{:keys [t fields pmasks]}] 796 | (let [fields (map munge fields)] 797 | (emitln "") 798 | (emitln "/**") 799 | (emitln "* @constructor") 800 | (emitln "*/") 801 | (emitln (munge t) " = (function (" (comma-sep fields) "){") 802 | (doseq [fld fields] 803 | (emitln "this." fld " = " fld ";")) 804 | (doseq [[pno pmask] pmasks] 805 | (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";")) 806 | (emitln "})"))) 807 | 808 | (defmethod emit* :defrecord* 809 | [{:keys [t fields pmasks]}] 810 | (let [fields (concat (map munge fields) '[__meta __extmap])] 811 | (emitln "") 812 | (emitln "/**") 813 | (emitln "* @constructor") 814 | (doseq [fld fields] 815 | (emitln "* @param {*} " fld)) 816 | (emitln "* @param {*=} __meta ") 817 | (emitln "* @param {*=} __extmap") 818 | (emitln "*/") 819 | (emitln (munge t) " = (function (" (comma-sep fields) "){") 820 | (doseq [fld fields] 821 | (emitln "this." fld " = " fld ";")) 822 | (doseq [[pno pmask] pmasks] 823 | (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";")) 824 | (emitln "if(arguments.length>" (- (count fields) 2) "){") 825 | (emitln "this.__meta = __meta;") 826 | (emitln "this.__extmap = __extmap;") 827 | (emitln "} else {") 828 | (emits "this.__meta=") 829 | (emit-constant nil) 830 | (emitln ";") 831 | (emits "this.__extmap=") 832 | (emit-constant nil) 833 | (emitln ";") 834 | (emitln "}") 835 | (emitln "})"))) 836 | 837 | (defmethod emit* :dot 838 | [{:keys [target field method args env]}] 839 | (emit-wrap env 840 | (if field 841 | (emits target "." (munge field #{})) 842 | (emits target "." (munge method #{}) "(" 843 | (comma-sep args) 844 | ")")))) 845 | 846 | (defmethod emit* :terra 847 | [{:keys [env code segs args]}] 848 | (emit-wrap env 849 | (if code 850 | (emits code) 851 | (emits (interleave (concat segs (repeat nil)) 852 | (concat args [nil])))))) 853 | 854 | (defn rename-to-tra 855 | "Change the file extension from .cljs to .t. Takes a File or a 856 | String. Always returns a String." 857 | [file-str] 858 | (clojure.string/replace file-str #"\.cljs$" ".t")) 859 | 860 | (defn mkdirs 861 | "Create all parent directories for the passed file." 862 | [^File f] 863 | (.mkdirs (.getParentFile (.getCanonicalFile f)))) 864 | 865 | (defmacro with-core-cljs 866 | "Ensure that core.cljs has been loaded." 867 | [& body] 868 | `(do (when-not (get-in @env/*compiler* [::ana/namespaces 'cljs.core :defs]) 869 | (ana/analyze-file "cljs/core.cljs")) 870 | ~@body)) 871 | 872 | (defn url-path [^File f] 873 | (.getPath (.toURL (.toURI f)))) 874 | 875 | (defn compile-file* 876 | ([src dest] (compile-file* src dest nil)) 877 | ([src dest opts] 878 | (env/ensure 879 | (with-core-cljs 880 | (with-open [out ^java.io.Writer (io/make-writer dest {})] 881 | (binding [*out* out 882 | ana/*cljs-ns* 'cljs.user 883 | ana/*cljs-file* (.getPath ^File src) 884 | reader/*alias-map* (or reader/*alias-map* {}) 885 | *source-map-data* (when (:source-map opts) 886 | (atom 887 | {:source-map (sorted-map) 888 | :gen-col 0 889 | :gen-line 0}))] 890 | (emitln "// Compiled by ClojureScript " (clojurescript-version)) 891 | (loop [forms (ana/forms-seq src) 892 | ns-name nil 893 | deps nil] 894 | (if (seq forms) 895 | (let [env (ana/empty-env) 896 | ast (ana/analyze env (first forms))] 897 | (do (emit ast) 898 | (if (= (:op ast) :ns) 899 | (recur (rest forms) (:name ast) (merge (:uses ast) (:requires ast))) 900 | (recur (rest forms) ns-name deps)))) 901 | (let [sm-data (when *source-map-data* @*source-map-data*) 902 | ret (merge 903 | {:ns (or ns-name 'cljs.user) 904 | :provides [ns-name] 905 | :requires (if (= ns-name 'cljs.core) 906 | (set (vals deps)) 907 | (cond-> (conj (set (vals deps)) 'cljs.core) 908 | (get-in @env/*compiler* [:opts :emit-constants]) 909 | (conj 'constants-table))) 910 | :file dest 911 | :source-file src} 912 | (when sm-data 913 | {:source-map (:source-map sm-data)}))] 914 | (when (and sm-data (= (:optimizations opts) :none)) 915 | (let [sm-file (io/file (str (.getPath ^File dest) ".map"))] 916 | (emits "\n//# sourceMappingURL=" (.getName sm-file)) 917 | (spit sm-file 918 | (sm/encode {(url-path src) (:source-map sm-data)} 919 | {:lines (+ (:gen-line sm-data) 2) 920 | :file (url-path dest)})))) 921 | (let [path (.getPath (.toURL ^File dest))] 922 | (swap! env/*compiler* assoc-in [::compiled-cljs path] ret) 923 | (swap! env/*compiler* assoc-in [::ana/analyzed-cljs path] true)) 924 | ret))))))))) 925 | 926 | (defn compiled-by-version [^File f] 927 | (let [match (->> (io/reader f) 928 | line-seq first 929 | (re-matches #".*ClojureScript (.*)$"))] 930 | (and match (second match)))) 931 | 932 | (defn requires-compilation? 933 | "Return true if the src file requires compilation." 934 | ([src dest] (requires-compilation? src dest nil)) 935 | ([^File src ^File dest opts] 936 | (env/ensure 937 | (or (not (.exists dest)) 938 | (> (.lastModified src) (.lastModified dest)) 939 | (let [version' (compiled-by-version dest) 940 | version (clojurescript-version)] 941 | (and version (not= version version'))) 942 | (and opts 943 | (:source-map opts) 944 | (if (= (:optimizations opts) :none) 945 | (not (.exists (io/file (str (.getPath dest) ".map")))) 946 | (not (get-in @env/*compiler* [::compiled-cljs (.getAbsolutePath dest)])))))))) 947 | 948 | (defn parse-ns 949 | ([src] (parse-ns src nil nil)) 950 | ([src dest opts] 951 | (env/ensure 952 | (let [namespaces' (::ana/namespaces @env/*compiler*) 953 | ret 954 | (binding [ana/*cljs-ns* 'cljs.user 955 | ana/*analyze-deps* false] 956 | (loop [forms (ana/forms-seq src)] 957 | (if (seq forms) 958 | (let [env (ana/empty-env) 959 | ast (ana/no-warn (ana/analyze env (first forms)))] 960 | (if (= (:op ast) :ns) 961 | (let [ns-name (:name ast) 962 | deps (merge (:uses ast) (:requires ast))] 963 | (merge 964 | {:ns (or ns-name 'cljs.user) 965 | :provides [ns-name] 966 | :requires (if (= ns-name 'cljs.core) 967 | (set (vals deps)) 968 | (cond-> (conj (set (vals deps)) 'cljs.core) 969 | (get-in @env/*compiler* [:opts :emit-constants]) 970 | (conj 'constants-table))) 971 | :file dest 972 | :source-file src} 973 | (when (and dest (.exists ^File dest)) 974 | {:lines (-> (io/reader dest) line-seq count)}))) 975 | (recur (rest forms)))))))] 976 | ;; TODO this _was_ a reset! of the old ana/namespaces atom; should we capture and 977 | ;; then restore the entirety of env/*compiler* here instead? 978 | (swap! env/*compiler* assoc ::ana/namespaces namespaces') 979 | ret)))) 980 | 981 | (defn compile-file 982 | "Compiles src to a file of the same name, but with a .js extension, 983 | in the src file's directory. 984 | 985 | With dest argument, write file to provided location. If the dest 986 | argument is a file outside the source tree, missing parent 987 | directories will be created. The src file will only be compiled if 988 | the dest file has an older modification time. 989 | 990 | Both src and dest may be either a String or a File. 991 | 992 | Returns a map containing {:ns .. :provides .. :requires .. :file ..}. 993 | If the file was not compiled returns only {:file ...}" 994 | ([src] 995 | (let [dest (rename-to-js src)] 996 | (compile-file src dest nil))) 997 | ([src dest] 998 | (compile-file src dest nil)) 999 | ([src dest opts] 1000 | (let [src-file (io/file src) 1001 | dest-file (io/file dest)] 1002 | (if (.exists src-file) 1003 | (try 1004 | (let [{ns :ns :as ns-info} (parse-ns src-file dest-file opts)] 1005 | (if (or (requires-compilation? src-file dest-file opts)) 1006 | (do (mkdirs dest-file) 1007 | (when (contains? (::ana/namespaces @env/*compiler*) ns) 1008 | (swap! env/*compiler* update-in [::ana/namespaces] dissoc ns)) 1009 | (compile-file* src-file dest-file opts)) 1010 | (do 1011 | (when-not (contains? (::ana/namespaces @env/*compiler*) ns) 1012 | (with-core-cljs 1013 | (ana/analyze-file src-file))) 1014 | ns-info))) 1015 | (catch Exception e 1016 | (throw (ex-info (str "failed compiling file:" src) {:file src} e)))) 1017 | (throw (java.io.FileNotFoundException. (str "The file " src " does not exist."))))))) 1018 | 1019 | (defn path-seq 1020 | [file-str] 1021 | (->> File/separator 1022 | java.util.regex.Pattern/quote 1023 | re-pattern 1024 | (string/split file-str))) 1025 | 1026 | (defn to-path 1027 | ([parts] 1028 | (to-path parts File/separator)) 1029 | ([parts sep] 1030 | (apply str (interpose sep parts)))) 1031 | 1032 | (defn ^File to-target-file 1033 | [target cljs-file] 1034 | (let [relative-path (string/split 1035 | (ana/munge-path 1036 | (str (:ns (parse-ns cljs-file)))) #"\.") 1037 | parents (butlast relative-path)] 1038 | (io/file 1039 | (io/file (to-path (cons target parents))) 1040 | (str (last relative-path) ".js")))) 1041 | 1042 | (defn cljs-files-in 1043 | "Return a sequence of all .cljs files in the given directory." 1044 | [dir] 1045 | (filter #(let [name (.getName ^File %)] 1046 | (and (.endsWith name ".cljs") 1047 | (not= \. (first name)) 1048 | (not (contains? cljs-reserved-file-names name)))) 1049 | (file-seq dir))) 1050 | 1051 | (defn compile-root 1052 | "Looks recursively in src-dir for .cljs files and compiles them to 1053 | .js files. If target-dir is provided, output will go into this 1054 | directory mirroring the source directory structure. Returns a list 1055 | of maps containing information about each file which was compiled 1056 | in dependency order." 1057 | ([src-dir] 1058 | (compile-root src-dir "out")) 1059 | ([src-dir target-dir] 1060 | (compile-root src-dir target-dir nil)) 1061 | ([src-dir target-dir opts] 1062 | (let [src-dir-file (io/file src-dir)] 1063 | (loop [cljs-files (cljs-files-in src-dir-file) 1064 | output-files []] 1065 | (if (seq cljs-files) 1066 | (let [cljs-file (first cljs-files) 1067 | output-file (to-target-file target-dir cljs-file) 1068 | ns-info (compile-file cljs-file output-file opts)] 1069 | (recur (rest cljs-files) (conj output-files (assoc ns-info :file-name (.getPath output-file))))) 1070 | output-files))))) 1071 | 1072 | ;; TODO: needs fixing, table will include other things than keywords - David 1073 | 1074 | (defn emit-constants-table [table] 1075 | (doseq [[keyword value] table] 1076 | (let [ns (namespace keyword) 1077 | name (name keyword)] 1078 | (emits "cljs.core." value " = new cljs.core.Keyword(") 1079 | (emit-constant ns) 1080 | (emits ",") 1081 | (emit-constant name) 1082 | (emits ",") 1083 | (emit-constant (if ns 1084 | (str ns "/" name) 1085 | name)) 1086 | (emits ");\n")))) 1087 | 1088 | (defn emit-constants-table-to-file [table dest] 1089 | (with-open [out ^java.io.Writer (io/make-writer dest {})] 1090 | (binding [*out* out] 1091 | (emit-constants-table table)))) 1092 | -------------------------------------------------------------------------------- /src/cljs/terra/core.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 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 | ; Additions and Updates made by Paul deGrandis 10 | 11 | (ns cljs.terra.core 12 | (:refer-clojure :exclude [-> ->> .. amap and areduce alength aclone assert binding bound-fn case comment cond condp 13 | declare definline definterface defmethod defmulti defn defn- defonce 14 | defprotocol defrecord defstruct deftype delay destructure doseq dosync dotimes doto 15 | extend-protocol extend-type fn for future gen-class gen-interface 16 | if-let if-not import io! lazy-cat lazy-seq let letfn locking loop 17 | memfn ns or proxy proxy-super pvalues refer-clojure reify sync time 18 | when when-first when-let when-not while with-bindings with-in-str 19 | with-loading-context with-local-vars with-open with-out-str with-precision with-redefs 20 | satisfies? identical? true? false? number? nil? instance? symbol? keyword? string? str get 21 | make-array vector list hash-map array-map hash-set 22 | 23 | aget aset 24 | + - * / < <= > >= == zero? pos? neg? inc dec max min mod 25 | byte char short int long float double 26 | unchecked-byte unchecked-char unchecked-short unchecked-int 27 | unchecked-long unchecked-float unchecked-double 28 | unchecked-add unchecked-add-int unchecked-dec unchecked-dec-int 29 | unchecked-divide unchecked-divide-int unchecked-inc unchecked-inc-int 30 | unchecked-multiply unchecked-multiply-int unchecked-negate unchecked-negate-int 31 | unchecked-subtract unchecked-subtract-int unchecked-remainder-int 32 | 33 | bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set 34 | bit-test bit-shift-left bit-shift-right bit-xor 35 | 36 | cond-> cond->> as-> some-> some->>]) 37 | (:require clojure.walk 38 | clojure.set 39 | cljs.terra.compiler 40 | [cljs.env :as env])) 41 | 42 | (alias 'core 'clojure.core) 43 | (alias 'ana 'cljs.terra.analyzer) 44 | 45 | 46 | (defmacro import-macros [ns [& vars]] 47 | (core/let [ns (find-ns ns) 48 | vars (map #(ns-resolve ns %) vars) 49 | syms (map (core/fn [^clojure.lang.Var v] (core/-> v .sym (with-meta {:macro true}))) vars) 50 | defs (map (core/fn [sym var] 51 | `(def ~sym (deref ~var))) syms vars)] 52 | `(do ~@defs 53 | :imported))) 54 | 55 | (import-macros clojure.core 56 | [-> ->> .. assert comment cond 57 | declare defn defn- 58 | doto 59 | extend-protocol fn for 60 | if-let if-not letfn 61 | memfn 62 | when when-first when-let when-not while 63 | cond-> cond->> as-> some-> some->>]) 64 | 65 | (defmacro ^{:private true} assert-args [fnname & pairs] 66 | `(do (when-not ~(first pairs) 67 | (throw (IllegalArgumentException. 68 | ~(core/str fnname " requires " (second pairs))))) 69 | ~(core/let [more (nnext pairs)] 70 | (when more 71 | (list* `assert-args fnname more))))) 72 | 73 | (defn destructure [bindings] 74 | (core/let [bents (partition 2 bindings) 75 | pb (fn pb [bvec b v] 76 | (core/let [pvec 77 | (fn [bvec b val] 78 | (core/let [gvec (gensym "vec__")] 79 | (core/loop [ret (-> bvec (conj gvec) (conj val)) 80 | n 0 81 | bs b 82 | seen-rest? false] 83 | (if (seq bs) 84 | (core/let [firstb (first bs)] 85 | (core/cond 86 | (= firstb '&) (recur (pb ret (second bs) (core/list `nthnext gvec n)) 87 | n 88 | (nnext bs) 89 | true) 90 | (= firstb :as) (pb ret (second bs) gvec) 91 | :else (if seen-rest? 92 | (throw (new Exception "Unsupported binding form, only :as can follow & parameter")) 93 | (recur (pb ret firstb (core/list `nth gvec n nil)) 94 | (core/inc n) 95 | (next bs) 96 | seen-rest?)))) 97 | ret)))) 98 | pmap 99 | (fn [bvec b v] 100 | (core/let [gmap (gensym "map__") 101 | defaults (:or b)] 102 | (core/loop [ret (-> bvec (conj gmap) (conj v) 103 | (conj gmap) (conj `(if (seq? ~gmap) (apply core/hash-map ~gmap) ~gmap)) 104 | ((fn [ret] 105 | (if (:as b) 106 | (conj ret (:as b) gmap) 107 | ret)))) 108 | bes (reduce 109 | (fn [bes entry] 110 | (reduce #(assoc %1 %2 ((val entry) %2)) 111 | (dissoc bes (key entry)) 112 | ((key entry) bes))) 113 | (dissoc b :as :or) 114 | {:keys #(keyword (core/str %)), :strs core/str, :syms #(core/list `quote %)})] 115 | (if (seq bes) 116 | (core/let [bb (key (first bes)) 117 | bk (val (first bes)) 118 | has-default (contains? defaults bb)] 119 | (recur (pb ret bb (if has-default 120 | (core/list `get gmap bk (defaults bb)) 121 | (core/list `get gmap bk))) 122 | (next bes))) 123 | ret))))] 124 | (core/cond 125 | (core/symbol? b) (-> bvec (conj b) (conj v)) 126 | (vector? b) (pvec bvec b v) 127 | (map? b) (pmap bvec b v) 128 | :else (throw (new Exception (core/str "Unsupported binding form: " b)))))) 129 | process-entry (fn [bvec b] (pb bvec (first b) (second b)))] 130 | (if (every? core/symbol? (map first bents)) 131 | bindings 132 | (reduce process-entry [] bents)))) 133 | 134 | (defmacro let 135 | "binding => binding-form init-expr 136 | 137 | Evaluates the exprs in a lexical context in which the symbols in 138 | the binding-forms are bound to their respective init-exprs or parts 139 | therein." 140 | [bindings & body] 141 | (assert-args 142 | (vector? bindings) "a vector for its binding" 143 | (even? (count bindings)) "an even number of forms in binding vector") 144 | `(let* ~(destructure bindings) ~@body)) 145 | 146 | (defmacro loop 147 | "Evaluates the exprs in a lexical context in which the symbols in 148 | the binding-forms are bound to their respective init-exprs or parts 149 | therein. Acts as a recur target." 150 | [bindings & body] 151 | (assert-args 152 | (vector? bindings) "a vector for its binding" 153 | (even? (count bindings)) "an even number of forms in binding vector") 154 | (let [db (destructure bindings)] 155 | (if (= db bindings) 156 | `(loop* ~bindings ~@body) 157 | (let [vs (take-nth 2 (drop 1 bindings)) 158 | bs (take-nth 2 bindings) 159 | gs (map (fn [b] (if (core/symbol? b) b (gensym))) bs) 160 | bfs (reduce (fn [ret [b v g]] 161 | (if (core/symbol? b) 162 | (conj ret g v) 163 | (conj ret g v b g))) 164 | [] (map core/vector bs vs gs))] 165 | `(let ~bfs 166 | (loop* ~(vec (interleave gs gs)) 167 | (let ~(vec (interleave bs gs)) 168 | ~@body))))))) 169 | 170 | (def fast-path-protocols 171 | "protocol fqn -> [partition number, bit]" 172 | (zipmap (map #(symbol "cljs.core" (core/str %)) 173 | '[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq INext 174 | ILookup IAssociative IMap IMapEntry ISet IStack IVector IDeref 175 | IDerefWithTimeout IMeta IWithMeta IReduce IKVReduce IEquiv IHash 176 | ISeqable ISequential IList IRecord IReversible ISorted IPrintWithWriter IWriter 177 | IPrintWithWriter IPending IWatchable IEditableCollection ITransientCollection 178 | ITransientAssociative ITransientMap ITransientVector ITransientSet 179 | IMultiFn IChunkedSeq IChunkedNext IComparable INamed ICloneable]) 180 | (iterate (fn [[p b]] 181 | (if (core/== 2147483648 b) 182 | [(core/inc p) 1] 183 | [p (core/bit-shift-left b 1)])) 184 | [0 1]))) 185 | 186 | (def fast-path-protocol-partitions-count 187 | "total number of partitions" 188 | (let [c (count fast-path-protocols) 189 | m (core/mod c 32)] 190 | (if (core/zero? m) 191 | (core/quot c 32) 192 | (core/inc (core/quot c 32))))) 193 | 194 | (defmacro str [& xs] 195 | (let [strs (->> (repeat (count xs) "cljs.core.str(~{})") 196 | (interpose ",") 197 | (apply core/str))] 198 | (concat (list 'host* (core/str "table.concat({" strs "})")) xs))) 199 | 200 | (defn bool-expr [e] 201 | (vary-meta e assoc :tag 'boolean)) 202 | 203 | (defn simple-test-expr? [env ast] 204 | (core/and 205 | (#{:var :invoke :constant :dot :terra} (:op ast)) 206 | ('#{boolean seq} (cljs.terra.analyzer/infer-tag env ast)))) 207 | 208 | (defmacro and 209 | "Evaluates exprs one at a time, from left to right. If a form 210 | returns logical false (nil or false), and returns that value and 211 | doesn't evaluate any of the other expressions, otherwise it returns 212 | the value of the last expr. (and) returns true." 213 | ([] true) 214 | ([x] x) 215 | ([x & next] 216 | (let [forms (concat [x] next)] 217 | (if (every? #(simple-test-expr? &env %) 218 | (map #(cljs.terra.analyzer/analyze &env %) forms)) 219 | (let [and-str (->> (repeat (count forms) "(~{})") 220 | (interpose " and ") 221 | (apply core/str))] 222 | (bool-expr `(~'host* ~and-str ~@forms))) 223 | `(let [and# ~x] 224 | (if and# (and ~@next) and#)))))) 225 | 226 | (defmacro or 227 | "Evaluates exprs one at a time, from left to right. If a form 228 | returns a logical true value, or returns that value and doesn't 229 | evaluate any of the other expressions, otherwise it returns the 230 | value of the last expression. (or) returns nil." 231 | ([] nil) 232 | ([x] x) 233 | ([x & next] 234 | (let [forms (concat [x] next)] 235 | (if (every? #(simple-test-expr? &env %) 236 | (map #(cljs.terra.analyzer/analyze &env %) forms)) 237 | (let [or-str (->> (repeat (count forms) "(~{})") 238 | (interpose " or ") 239 | (apply core/str))] 240 | (bool-expr `(~'host* ~or-str ~@forms))) 241 | `(let [or# ~x] 242 | (if or# or# (or ~@next))))))) 243 | 244 | (defmacro nil? [x] 245 | `(coercive-= ~x nil)) 246 | 247 | ;; internal - do not use. 248 | (defmacro coercive-not [x] 249 | (bool-expr (core/list 'host* "(not ~{})" x))) 250 | 251 | ;; internal - do not use. 252 | (defmacro coercive-not= [x y] 253 | (bool-expr (core/list 'host* "(~{} ~= ~{})" x y))) 254 | 255 | ;; internal - do not use. 256 | (defmacro coercive-= [x y] 257 | (bool-expr (core/list 'host* "(~{} == ~{})" x y))) 258 | 259 | ;; internal - do not use. 260 | (defmacro coercive-boolean [x] 261 | (with-meta (core/list 'host* "~{}" x) 262 | {:tag 'boolean})) 263 | 264 | ;; internal - do not use. 265 | (defmacro truth_ [x] 266 | (assert (clojure.core/symbol? x) "x is substituted twice") 267 | (core/list 'host* "(~{})" x)) 268 | 269 | ;; internal - do not use 270 | (defmacro terra-arguments [] 271 | (core/list 'host* "{ ... }")) 272 | 273 | (defmacro terra-delete [obj key] 274 | (core/list 'host* "~{}[~{}] = nil" obj key)) 275 | 276 | (defmacro true? [x] 277 | (bool-expr (core/list 'host* "~{} == true" x))) 278 | 279 | (defmacro false? [x] 280 | (bool-expr (core/list 'host* "~{} == false" x))) 281 | 282 | ;; TODO These are Lua Arrays - just Tables with standard indexes starting at 1 283 | ;; We need to make `tarray` and `tvector` 284 | (defmacro array? [x] 285 | (bool-expr (core/list 'host* "(~{}.constructor == cljs.core.Array)" x))) 286 | 287 | (defmacro string? [x] 288 | (bool-expr (core/list 'host* "(type ~{} == 'string')" x))) 289 | 290 | ;; TODO: x must be a symbol, not an arbitrary expression 291 | (defmacro exists? [x] 292 | (bool-expr 293 | (core/list 'host* "(~{} ~= nil)" 294 | (vary-meta x assoc :cljs.terra.analyzer/no-resolve true)))) 295 | 296 | (defmacro undefined? [x] 297 | (bool-expr (core/list 'host* "(nil == ~{})" x))) 298 | 299 | (defmacro identical? [a b] 300 | (bool-expr (core/list 'host* "(~{} == ~{})" a b))) 301 | 302 | (defmacro instance? [t o] 303 | ;; Google Closure warns about some references to RegExp, so 304 | ;; (instance? RegExp ...) needs to be inlined, but the expansion 305 | ;; should preserve the order of argument evaluation. 306 | (bool-expr (if (clojure.core/symbol? t) 307 | (core/list 'host* "(type ~{} == ~{})" o t) 308 | `(let [t# ~t o# ~o] 309 | (~'host* "(type ~{} == ~{})" o# t#))))) 310 | 311 | (defmacro number? [x] 312 | (bool-expr (core/list 'host* "(type ~{} == 'number')" x))) 313 | 314 | (defmacro symbol? [x] 315 | (bool-expr `(instance? Symbol ~x))) 316 | 317 | (defmacro keyword? [x] 318 | (bool-expr `(instance? Keyword ~x))) 319 | 320 | ;;TODO: Here - these should *ideally* be Terra arrays, but 321 | ;; in order for them to work with Lua Tables-as-arrays AND 322 | ;; Terra low-level arrays, we need a protocol. 323 | ;; If it was a protocol, we can make it work with Terra Vectors 324 | 325 | (defmacro aget 326 | ([a i] 327 | (core/list 'host* "(~{}[~{}])" a (inc i))) 328 | ([a i & idxs] 329 | (let [lua-idxs (map inc (conj idex i)) 330 | astr (apply core/str (repeat (count lua-idxs) "[~{}]"))] 331 | `(~'host* ~(core/str "(~{}" astr ")") ~a ~@lua-idxs)))) 332 | 333 | (defmacro aset 334 | ([a i v] 335 | (core/list 'host* "(~{}[~{}] = ~{})" a (inc i) v)) 336 | ([a idx idx2 & idxv] 337 | (let [lua-idxs (map inc (butlast idxv idx2 idx)) 338 | v (last idxv) 339 | astr (apply core/str (repeat (count lua-idxs) "[~{}]"))] 340 | `(~'host* ~(core/str "(~{}" astr " = ~{})") ~a ~lua-idxs ~v)))) 341 | 342 | (defmacro ^::ana/numeric + 343 | ([] 0) 344 | ([x] x) 345 | ([x y] (core/list 'host* "(~{} + ~{})" x y)) 346 | ([x y & more] `(+ (+ ~x ~y) ~@more))) 347 | 348 | ;; In terra, casts can only happen at specific places. 349 | ;; For now, these will remain the same 350 | ;; TODO: Come back here and figure out if casting is appropriate 351 | ;; We would need to know scope 352 | 353 | (defmacro byte [x] x) 354 | (defmacro short [x] x) 355 | (defmacro float [x] x) 356 | (defmacro double [x] x) 357 | 358 | (defmacro unchecked-byte [x] x) 359 | (defmacro unchecked-char [x] x) 360 | (defmacro unchecked-short [x] x) 361 | (defmacro unchecked-float [x] x) 362 | (defmacro unchecked-double [x] x) 363 | 364 | (defmacro ^::ana/numeric unchecked-add 365 | ([& xs] `(+ ~@xs))) 366 | 367 | (defmacro ^::ana/numeric unchecked-add-int 368 | ([& xs] `(+ ~@xs))) 369 | 370 | (defmacro ^::ana/numeric unchecked-dec 371 | ([x] `(dec ~x))) 372 | 373 | (defmacro ^::ana/numeric unchecked-dec-int 374 | ([x] `(dec ~x))) 375 | 376 | (defmacro ^::ana/numeric unchecked-divide-int 377 | ([& xs] `(/ ~@xs))) 378 | 379 | (defmacro ^::ana/numeric unchecked-inc 380 | ([x] `(inc ~x))) 381 | 382 | (defmacro ^::ana/numeric unchecked-inc-int 383 | ([x] `(inc ~x))) 384 | 385 | (defmacro ^::ana/numeric unchecked-multiply 386 | ([& xs] `(* ~@xs))) 387 | 388 | (defmacro ^::ana/numeric unchecked-multiply-int 389 | ([& xs] `(* ~@xs))) 390 | 391 | (defmacro ^::ana/numeric unchecked-negate 392 | ([x] `(- ~x))) 393 | 394 | (defmacro ^::ana/numeric unchecked-negate-int 395 | ([x] `(- ~x))) 396 | 397 | (defmacro ^::ana/numeric unchecked-remainder-int 398 | ([x n] `(mod ~x ~n))) 399 | 400 | (defmacro ^::ana/numeric unchecked-subtract 401 | ([& xs] `(- ~@xs))) 402 | 403 | (defmacro ^::ana/numeric unchecked-subtract-int 404 | ([& xs] `(- ~@xs))) 405 | 406 | (defmacro ^::ana/numeric - 407 | ([x] (core/list 'host* "(- ~{})" x)) 408 | ([x y] (core/list 'host* "(~{} - ~{})" x y)) 409 | ([x y & more] `(- (- ~x ~y) ~@more))) 410 | 411 | (defmacro ^::ana/numeric * 412 | ([] 1) 413 | ([x] x) 414 | ([x y] (core/list 'host* "(~{} * ~{})" x y)) 415 | ([x y & more] `(* (* ~x ~y) ~@more))) 416 | 417 | (defmacro ^::ana/numeric / 418 | ([x] `(/ 1 ~x)) 419 | ([x y] (core/list 'host* "(~{} / ~{})" x y)) 420 | ([x y & more] `(/ (/ ~x ~y) ~@more))) 421 | 422 | (defmacro ^::ana/numeric divide 423 | ([x] `(/ 1 ~x)) 424 | ([x y] (core/list 'host* "(~{} / ~{})" x y)) 425 | ([x y & more] `(/ (/ ~x ~y) ~@more))) 426 | 427 | (defmacro ^::ana/numeric < 428 | ([x] true) 429 | ([x y] (bool-expr (core/list 'host* "(~{} < ~{})" x y))) 430 | ([x y & more] `(and (< ~x ~y) (< ~y ~@more)))) 431 | 432 | (defmacro ^::ana/numeric <= 433 | ([x] true) 434 | ([x y] (bool-expr (core/list 'host* "(~{} <= ~{})" x y))) 435 | ([x y & more] `(and (<= ~x ~y) (<= ~y ~@more)))) 436 | 437 | (defmacro ^::ana/numeric > 438 | ([x] true) 439 | ([x y] (bool-expr (core/list 'host* "(~{} > ~{})" x y))) 440 | ([x y & more] `(and (> ~x ~y) (> ~y ~@more)))) 441 | 442 | (defmacro ^::ana/numeric >= 443 | ([x] true) 444 | ([x y] (bool-expr (core/list 'host* "(~{} >= ~{})" x y))) 445 | ([x y & more] `(and (>= ~x ~y) (>= ~y ~@more)))) 446 | 447 | (defmacro ^::ana/numeric == 448 | ([x] true) 449 | ([x y] (bool-expr (core/list 'host* "(~{} == ~{})" x y))) 450 | ([x y & more] `(and (== ~x ~y) (== ~y ~@more)))) 451 | 452 | (defmacro ^::ana/numeric dec [x] 453 | `(- ~x 1)) 454 | 455 | (defmacro ^::ana/numeric inc [x] 456 | `(+ ~x 1)) 457 | 458 | (defmacro ^::ana/numeric zero? [x] 459 | `(== ~x 0)) 460 | 461 | (defmacro ^::ana/numeric pos? [x] 462 | `(> ~x 0)) 463 | 464 | (defmacro ^::ana/numeric neg? [x] 465 | `(< ~x 0)) 466 | 467 | (defmacro ^::ana/numeric max 468 | ([x] x) 469 | ([x y] `(let [x# ~x, y# ~y] 470 | (~'host* "((~{} > ~{}) and ~{} or ~{})" x# y# x# y#))) 471 | ([x y & more] (core/list 'host* "(math.max(~{}))" (apply str (interpose ", " (conj more y x)))))) 472 | 473 | (defmacro ^::ana/numeric min 474 | ([x] x) 475 | ([x y] `(let [x# ~x, y# ~y] 476 | (~'host* "((~{} < ~{}) and ~{} or ~{})" x# y# x# y#))) 477 | ([x y & more] (core/list 'host* "(math.min(~{}))" (apply str (interpose ", " (conj more y x)))))) 478 | 479 | (defmacro ^::ana/numeric js-mod [num div] 480 | (core/list 'host* "(math.fmod(~{}, ~{}))" num div)) 481 | 482 | (defmacro ^::ana/numeric bit-not [x] 483 | (core/list 'host* "(bit.bnot(~{}))" x)) 484 | 485 | (defmacro ^::ana/numeric bit-and 486 | ([x y] (core/list 'host* "(bit.band(~{}, ~{}))" x y)) 487 | ([x y & more] `(bit-and (bit-and ~x ~y) ~@more))) 488 | 489 | ;; internal do not use 490 | (defmacro ^::ana/numeric unsafe-bit-and 491 | ([x y] (bool-expr (core/list 'host* "(bit.band(~{}, ~{}))" x y))) 492 | ([x y & more] `(unsafe-bit-and (unsafe-bit-and ~x ~y) ~@more))) 493 | 494 | (defmacro ^::ana/numeric bit-or 495 | ([x y] (core/list 'host* "(bit.bor(~{}, ~{}))" x y)) 496 | ([x y & more] `(bit-or (bit-or ~x ~y) ~@more))) 497 | 498 | (defmacro ^::ana/numeric int [x] 499 | `(bit-or ~x 0)) 500 | 501 | (defmacro ^::ana/numeric bit-xor 502 | ([x y] (core/list 'host* "(bit.bxor(~{}, ~{}))" x y)) 503 | ([x y & more] `(bit-xor (bit-xor ~x ~y) ~@more))) 504 | 505 | (defmacro ^::ana/numeric bit-and-not 506 | ([x y] (core/list 'host* "(bit.band(~{}, bit.bnot(~{})))" x y)) 507 | ([x y & more] `(bit-and-not (bit-and-not ~x ~y) ~@more))) 508 | 509 | (defmacro ^::ana/numeric bit-clear [x n] 510 | (core/list 'host* "(bit.band(~{}, bit.bnot(bit.lshift(1, ~{}))))" x n)) 511 | 512 | (defmacro ^::ana/numeric bit-flip [x n] 513 | (core/list 'host* "(bit.bxor(~{}, bit.lshift(1, ~{})))" x n)) 514 | 515 | (defmacro ^::ana/numeric bit-test [x n] 516 | (core/list 'host* "(bit.band(~{}, bit.lshift(1, ~{})) ~= 0)" x n)) 517 | 518 | (defmacro ^::ana/numeric bit-shift-left [x n] 519 | (core/list 'host* "(bit.lshift(~{}, ~{}))" x n)) 520 | 521 | (defmacro ^::ana/numeric bit-shift-right [x n] 522 | (core/list 'host* "(bit.arshift(~{}, ~{}))" x n)) 523 | 524 | (defmacro ^::ana/numeric bit-shift-right-zero-fill [x n] 525 | (core/list 'host* "(bit.rshift(~{}, ~{}))" x n)) 526 | 527 | (defmacro ^::ana/numeric unsigned-bit-shift-right [x n] 528 | (core/list 'host* "(bit.rshift(~{}, ~{}))" x n)) 529 | 530 | (defmacro ^::ana/numeric bit-set [x n] 531 | (core/list 'host* "(bit.bor(~{}, bit.lshift(1, ~{})))" x n)) 532 | 533 | ;; internal 534 | (defmacro mask [hash shift] 535 | (core/list 'host* "(bit.band(bit.rshift(~{}, ~{}), 0x01f))" hash shift)) 536 | 537 | ;; internal 538 | (defmacro bitpos [hash shift] 539 | (core/list 'host* "(bit.lshift(1, ~{}))" `(mask ~hash ~shift))) 540 | 541 | ;; internal 542 | (defmacro caching-hash [coll hash-fn hash-key] 543 | (assert (clojure.core/symbol? hash-key) "hash-key is substituted twice") 544 | `(let [h# ~hash-key] 545 | (if-not (nil? h#) 546 | h# 547 | (let [h# (~hash-fn ~coll)] 548 | (set! ~hash-key h#) 549 | h#)))) 550 | 551 | ;;; internal -- reducers-related macros 552 | 553 | (defn- do-curried 554 | [name doc meta args body] 555 | (let [cargs (vec (butlast args))] 556 | `(defn ~name ~doc ~meta 557 | (~cargs (fn [x#] (~name ~@cargs x#))) 558 | (~args ~@body)))) 559 | 560 | (defmacro ^:private defcurried 561 | "Builds another arity of the fn that returns a fn awaiting the last 562 | param" 563 | [name doc meta args & body] 564 | (do-curried name doc meta args body)) 565 | 566 | (defn- do-rfn [f1 k fkv] 567 | `(fn 568 | ([] (~f1)) 569 | ~(clojure.walk/postwalk 570 | #(if (sequential? %) 571 | ((if (vector? %) vec identity) 572 | (core/remove #{k} %)) 573 | %) 574 | fkv) 575 | ~fkv)) 576 | 577 | (defmacro ^:private rfn 578 | "Builds 3-arity reducing fn given names of wrapped fn and key, and k/v impl." 579 | [[f1 k] fkv] 580 | (do-rfn f1 k fkv)) 581 | 582 | ;;; end of reducers macros 583 | 584 | (defn protocol-prefix [psym] 585 | (core/str (-> (core/str psym) (.replaceAll "\\." "__") (.replaceAll "/" "__")) "__")) 586 | 587 | ;; TODO: this needs to be expanded for Terra types 588 | 589 | (def #^:private base-type 590 | {nil "nil" 591 | 'table "table" 592 | 'string "string" 593 | 'number "number" 594 | 'array "table" ;; TODO: this might be a mistake 595 | 'function "function" 596 | 'boolean "boolean" 597 | 'default "_"}) 598 | 599 | ;;TODO is this needed? 600 | (def #^:private host-base-type 601 | {'js/Boolean "boolean" 602 | 'js/String "string" 603 | 'js/Array "table" 604 | 'js/Number "number" 605 | 'js/Function "function"}) 606 | 607 | (defmacro reify [& impls] 608 | (let [t (gensym "t") 609 | meta-sym (gensym "meta") 610 | this-sym (gensym "_") 611 | locals (keys (:locals &env)) 612 | ns (-> &env :ns :name) 613 | munge cljs.compiler/munge] 614 | `(do 615 | (when-not (exists? ~(symbol (core/str ns) (core/str t))) 616 | (deftype ~t [~@locals ~meta-sym] 617 | IWithMeta 618 | (~'-with-meta [~this-sym ~meta-sym] 619 | (new ~t ~@locals ~meta-sym)) 620 | IMeta 621 | (~'-meta [~this-sym] ~meta-sym) 622 | ~@impls)) 623 | (new ~t ~@locals nil)))) 624 | 625 | (defmacro specify [expr & impls] 626 | (let [x (with-meta (gensym "x") {:extend :instance})] 627 | `(let [~x (cljs.core/clone ~expr)] 628 | (extend-type ~x ~@impls) 629 | ~x))) 630 | 631 | (defmacro ^:private js-this [] 632 | (core/list 'js* "this")) 633 | 634 | (defmacro this-as 635 | "Defines a scope where JavaScript's implicit \"this\" is bound to the name provided." 636 | [name & body] 637 | `(let [~name (js-this)] 638 | ~@body)) 639 | 640 | (defn to-property [sym] 641 | (symbol (core/str "-" sym))) 642 | 643 | (defn warn-and-update-protocol [p type env] 644 | (when-not (= 'Object p) 645 | (if-let [var (cljs.terra.analyzer/resolve-existing-var (dissoc env :locals) p)] 646 | (do 647 | (when-not (:protocol-symbol var) 648 | (cljs.terra.analyzer/warning :invalid-protocol-symbol env {:protocol p})) 649 | (when (core/and (:protocol-deprecated cljs.terra.analyzer/*cljs-warnings*) 650 | (-> var :deprecated) 651 | (not (-> p meta :deprecation-nowarn))) 652 | (cljs.terra.analyzer/warning :protocol-deprecated env {:protocol p})) 653 | (when (:protocol-symbol var) 654 | (swap! env/*compiler* update-in [:cljs.terra.analyzer/namespaces] 655 | (fn [ns] 656 | (update-in ns [(:ns var) :defs (symbol (name p)) :impls] 657 | conj type))))) 658 | (when (:undeclared cljs.terra.analyzer/*cljs-warnings*) 659 | (cljs.terra.analyzer/warning :undeclared-protocol-symbol env {:protocol p}))))) 660 | 661 | (defn resolve-var [env sym] 662 | (let [ret (-> (dissoc env :locals) 663 | (cljs.terra.analyzer/resolve-var sym) 664 | :name)] 665 | (assert ret (core/str "Can't resolve: " sym)) 666 | ret)) 667 | 668 | (defn ->impl-map [impls] 669 | (loop [ret {} s impls] 670 | (if (seq s) 671 | (recur (assoc ret (first s) (take-while seq? (next s))) 672 | (drop-while seq? (next s))) 673 | ret))) 674 | 675 | (defn base-assign-impls [env resolve tsym type [p sigs]] 676 | (warn-and-update-protocol p tsym env) 677 | (let [psym (resolve p) 678 | pfn-prefix (subs (core/str psym) 0 679 | (clojure.core/inc (.indexOf (core/str psym) "/")))] 680 | (cons `(aset ~psym ~type true) 681 | (map (fn [[f & meths :as form]] 682 | `(aset ~(symbol (core/str pfn-prefix f)) 683 | ~type ~(with-meta `(fn ~@meths) (meta form)))) 684 | sigs)))) 685 | 686 | (core/defmulti extend-prefix (fn [tsym sym] (-> tsym meta :extend))) 687 | 688 | (core/defmethod extend-prefix :instance 689 | [tsym sym] `(.. ~tsym ~(to-property sym))) 690 | 691 | (core/defmethod extend-prefix :default 692 | [tsym sym] `(.. ~tsym -prototype ~(to-property sym))) 693 | 694 | (defn adapt-obj-params [type [[this & args :as sig] & body]] 695 | (core/list (vec args) 696 | (list* 'this-as (vary-meta this assoc :tag type) body))) 697 | 698 | (defn adapt-ifn-params [type [[this & args :as sig] & body]] 699 | (let [self-sym (with-meta 'self__ {:tag type})] 700 | `(~(vec (cons self-sym args)) 701 | (this-as ~self-sym 702 | (let [~this ~self-sym] 703 | ~@body))))) 704 | 705 | ;; for IFn invoke implementations, we need to drop first arg 706 | (defn adapt-ifn-invoke-params [type [[this & args :as sig] & body]] 707 | `(~(vec args) 708 | (this-as ~(vary-meta this assoc :tag type) 709 | ~@body))) 710 | 711 | (defn adapt-proto-params [type [[this & args :as sig] & body]] 712 | `(~(vec (cons (vary-meta this assoc :tag type) args)) 713 | (this-as ~this 714 | ~@body))) 715 | 716 | (defn add-obj-methods [type type-sym sigs] 717 | (map (fn [[f & meths :as form]] 718 | `(set! ~(extend-prefix type-sym f) 719 | ~(with-meta `(fn ~@(map #(adapt-obj-params type %) meths)) (meta form)))) 720 | sigs)) 721 | 722 | (defn ifn-invoke-methods [type type-sym [f & meths :as form]] 723 | (map 724 | (fn [meth] 725 | (let [arity (count (first meth))] 726 | `(set! ~(extend-prefix type-sym (symbol (core/str "cljs__core__IFn___invoke__arity__" arity))) 727 | ~(with-meta `(fn ~meth) (meta form))))) 728 | (map #(adapt-ifn-invoke-params type %) meths))) 729 | 730 | (defn add-ifn-methods [type type-sym [f & meths :as form]] 731 | (let [meths (map #(adapt-ifn-params type %) meths) 732 | this-sym (with-meta 'self__ {:tag type}) 733 | argsym (gensym "args")] 734 | (concat 735 | [`(set! ~(extend-prefix type-sym 'call) ~(with-meta `(fn ~@meths) (meta form))) 736 | `(set! ~(extend-prefix type-sym 'apply) 737 | ~(with-meta 738 | `(fn ~[this-sym argsym] 739 | (this-as ~this-sym 740 | (.apply (.-call ~this-sym) ~this-sym 741 | (.concat (array ~this-sym) (aclone ~argsym))))) 742 | (meta form)))] 743 | (ifn-invoke-methods type type-sym form)))) 744 | 745 | (defn add-proto-methods* [pprefix type type-sym [f & meths :as form]] 746 | (let [pf (core/str pprefix f)] 747 | (if (vector? (first meths)) 748 | ;; single method case 749 | (let [meth meths] 750 | [`(set! ~(extend-prefix type-sym (core/str pf "__arity__" (count (first meth)))) 751 | ~(with-meta `(fn ~@(adapt-proto-params type meth)) (meta form)))]) 752 | (map (fn [[sig & body :as meth]] 753 | `(set! ~(extend-prefix type-sym (core/str pf "__arity__" (count sig))) 754 | ~(with-meta `(fn ~(adapt-proto-params type meth)) (meta form)))) 755 | meths)))) 756 | 757 | (defn proto-assign-impls [env resolve type-sym type [p sigs]] 758 | (warn-and-update-protocol p type env) 759 | (let [psym (resolve p) 760 | pprefix (protocol-prefix psym) 761 | skip-flag (set (-> type-sym meta :skip-protocol-flag))] 762 | (if (= p 'Object) 763 | (add-obj-methods type type-sym sigs) 764 | (concat 765 | (when-not (skip-flag psym) 766 | [`(set! ~(extend-prefix type-sym pprefix) true)]) 767 | (mapcat 768 | (fn [sig] 769 | (if (= psym 'cljs.core/IFn) 770 | (add-ifn-methods type type-sym sig) 771 | (add-proto-methods* pprefix type type-sym sig))) 772 | sigs))))) 773 | 774 | (defmacro extend-type [type-sym & impls] 775 | (let [env &env 776 | resolve (partial resolve-var env) 777 | impl-map (->impl-map impls) 778 | [type assign-impls] (if-let [type (base-type type-sym)] 779 | [type base-assign-impls] 780 | [(resolve type-sym) proto-assign-impls])] 781 | (when (core/and (:extending-base-host-type cljs.terra.analyzer/*cljs-warnings*) 782 | (host-base-type type-sym)) 783 | (cljs.terra.analyzer/warning :extending-base-host-type env 784 | {:current-symbol type-sym :suggested-symbol (host-base-type type-sym)})) 785 | `(do ~@(mapcat #(assign-impls env resolve type-sym type %) impl-map)))) 786 | 787 | (defn- prepare-protocol-masks [env impls] 788 | (let [resolve (partial resolve-var env) 789 | impl-map (->impl-map impls) 790 | fpp-pbs (seq 791 | (keep fast-path-protocols 792 | (map resolve 793 | (keys impl-map))))] 794 | (if fpp-pbs 795 | (let [fpps (into #{} 796 | (filter (partial contains? fast-path-protocols) 797 | (map resolve (keys impl-map)))) 798 | parts (as-> (group-by first fpp-pbs) parts 799 | (into {} 800 | (map (juxt key (comp (partial map peek) val)) 801 | parts)) 802 | (into {} 803 | (map (juxt key (comp (partial reduce core/bit-or) val)) 804 | parts)))] 805 | [fpps (reduce (fn [ps p] (update-in ps [p] (fnil identity 0))) 806 | parts 807 | (range fast-path-protocol-partitions-count))])))) 808 | 809 | (defn annotate-specs [annots v [f sigs]] 810 | (conj v 811 | (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs)) 812 | merge annots))) 813 | 814 | (defn dt->et 815 | ([type specs fields] 816 | (dt->et type specs fields false)) 817 | ([type specs fields inline] 818 | (let [annots {:cljs.terra.analyzer/type type 819 | :cljs.terra.analyzer/fields fields 820 | :protocol-impl true 821 | :protocol-inline inline}] 822 | (loop [ret [] specs specs] 823 | (if (seq specs) 824 | (let [ret (-> (conj ret (first specs)) 825 | (into (reduce (partial annotate-specs annots) [] 826 | (group-by first (take-while seq? (next specs)))))) 827 | specs (drop-while seq? (next specs))] 828 | (recur ret specs)) 829 | ret))))) 830 | 831 | (defn collect-protocols [impls env] 832 | (->> impls 833 | (filter core/symbol?) 834 | (map #(:name (cljs.terra.analyzer/resolve-var (dissoc env :locals) %))) 835 | (into #{}))) 836 | 837 | (defn- build-positional-factory 838 | [rsym rname fields] 839 | (let [fn-name (symbol (core/str '-> rsym))] 840 | `(defn ~fn-name 841 | [~@fields] 842 | (new ~rname ~@fields)))) 843 | 844 | (defmacro deftype [t fields & impls] 845 | (let [r (:name (cljs.terra.analyzer/resolve-var (dissoc &env :locals) t)) 846 | [fpps pmasks] (prepare-protocol-masks &env impls) 847 | protocols (collect-protocols impls &env) 848 | t (vary-meta t assoc 849 | :protocols protocols 850 | :skip-protocol-flag fpps) ] 851 | (if (seq impls) 852 | `(do 853 | (deftype* ~t ~fields ~pmasks) 854 | (set! (.-cljs__lang__type ~t) true) 855 | (set! (.-cljs__lang__ctorStr ~t) ~(core/str r)) 856 | (set! (.-cljs__lang__ctorPrWriter ~t) (fn [this# writer# opt#] (-write writer# ~(core/str r)))) 857 | (extend-type ~t ~@(dt->et t impls fields true)) 858 | ~(build-positional-factory t r fields) 859 | ~t) 860 | `(do 861 | (deftype* ~t ~fields ~pmasks) 862 | (set! (.-cljs__lang__type ~t) true) 863 | (set! (.-cljs__lang__ctorStr ~t) ~(core/str r)) 864 | (set! (.-cljs__lang__ctorPrWriter ~t) (fn [this# writer# opts#] (-write writer# ~(core/str r)))) 865 | ~(build-positional-factory t r fields) 866 | ~t)))) 867 | 868 | (defn- emit-defrecord 869 | "Do not use this directly - use defrecord" 870 | [env tagname rname fields impls] 871 | (let [hinted-fields fields 872 | fields (vec (map #(with-meta % nil) fields)) 873 | base-fields fields 874 | pr-open (core/str "#" (.getNamespace rname) "." (.getName rname) "{") 875 | fields (conj fields '__meta '__extmap (with-meta '__hash {:mutable true}))] 876 | (let [gs (gensym) 877 | ksym (gensym "k") 878 | impls (concat 879 | impls 880 | ['IRecord 881 | 'ICloneable 882 | `(~'-clone [this#] (new ~tagname ~@fields)) 883 | 'IHash 884 | `(~'-hash [this#] (caching-hash this# ~'hash-imap ~'__hash)) 885 | 'IEquiv 886 | `(~'-equiv [this# other#] 887 | (if (and other# 888 | (identical? (.-constructor this#) 889 | (.-constructor other#)) 890 | (equiv-map this# other#)) 891 | true 892 | false)) 893 | 'IMeta 894 | `(~'-meta [this#] ~'__meta) 895 | 'IWithMeta 896 | `(~'-with-meta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields))) 897 | 'ILookup 898 | `(~'-lookup [this# k#] (-lookup this# k# nil)) 899 | `(~'-lookup [this# ~ksym else#] 900 | (cond 901 | ~@(mapcat (fn [f] [`(keyword-identical? ~ksym ~(keyword f)) f]) base-fields) 902 | :else (get ~'__extmap ~ksym else#))) 903 | 'ICounted 904 | `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap))) 905 | 'ICollection 906 | `(~'-conj [this# entry#] 907 | (if (vector? entry#) 908 | (-assoc this# (-nth entry# 0) (-nth entry# 1)) 909 | (reduce -conj 910 | this# 911 | entry#))) 912 | 'IAssociative 913 | `(~'-assoc [this# k# ~gs] 914 | (condp keyword-identical? k# 915 | ~@(mapcat (fn [fld] 916 | [(keyword fld) (list* `new tagname (replace {fld gs '__hash nil} fields))]) 917 | base-fields) 918 | (new ~tagname ~@(remove #{'__extmap '__hash} fields) (assoc ~'__extmap k# ~gs) nil))) 919 | 'IMap 920 | `(~'-dissoc [this# k#] (if (contains? #{~@(map keyword base-fields)} k#) 921 | (dissoc (with-meta (into {} this#) ~'__meta) k#) 922 | (new ~tagname ~@(remove #{'__extmap '__hash} fields) 923 | (not-empty (dissoc ~'__extmap k#)) 924 | nil))) 925 | 'ISeqable 926 | `(~'-seq [this#] (seq (concat [~@(map #(core/list `vector (keyword %) %) base-fields)] 927 | ~'__extmap))) 928 | 929 | 'IPrintWithWriter 930 | `(~'-pr-writer [this# writer# opts#] 931 | (let [pr-pair# (fn [keyval#] (pr-sequential-writer writer# pr-writer "" " " "" opts# keyval#))] 932 | (pr-sequential-writer 933 | writer# pr-pair# ~pr-open ", " "}" opts# 934 | (concat [~@(map #(core/list `vector (keyword %) %) base-fields)] 935 | ~'__extmap)))) 936 | ]) 937 | [fpps pmasks] (prepare-protocol-masks env impls) 938 | protocols (collect-protocols impls env) 939 | tagname (vary-meta tagname assoc 940 | :protocols protocols 941 | :skip-protocol-flag fpps)] 942 | `(do 943 | (~'defrecord* ~tagname ~hinted-fields ~pmasks) 944 | (extend-type ~tagname ~@(dt->et tagname impls fields true)))))) 945 | 946 | (defn- build-map-factory [rsym rname fields] 947 | (let [fn-name (symbol (core/str 'map-> rsym)) 948 | ms (gensym) 949 | ks (map keyword fields) 950 | getters (map (fn [k] `(~k ~ms)) ks)] 951 | `(defn ~fn-name [~ms] 952 | (new ~rname ~@getters nil (dissoc ~ms ~@ks))))) 953 | 954 | (defmacro defrecord [rsym fields & impls] 955 | (let [rsym (vary-meta rsym assoc :internal-ctor true) 956 | r (vary-meta 957 | (:name (cljs.terra.analyzer/resolve-var (dissoc &env :locals) rsym)) 958 | assoc :internal-ctor true)] 959 | `(let [] 960 | ~(emit-defrecord &env rsym r fields impls) 961 | (set! (.-cljs__lang__type ~r) true) 962 | (set! (.-cljs__lang__ctorPrSeq ~r) (fn [this#] (core/list ~(core/str r)))) 963 | (set! (.-cljs__lang__ctorPrWriter ~r) (fn [this# writer#] (-write writer# ~(core/str r)))) 964 | ~(build-positional-factory rsym r fields) 965 | ~(build-map-factory rsym r fields) 966 | ~r))) 967 | 968 | (defmacro defprotocol [psym & doc+methods] 969 | (let [p (:name (cljs.terra.analyzer/resolve-var (dissoc &env :locals) psym)) 970 | psym (vary-meta psym assoc :protocol-symbol true) 971 | ns-name (-> &env :ns :name) 972 | fqn (fn [n] (symbol (core/str ns-name "." n))) 973 | prefix (protocol-prefix p) 974 | methods (if (core/string? (first doc+methods)) (next doc+methods) doc+methods) 975 | expand-sig (fn [fname slot sig] 976 | `(~sig 977 | (if (and ~(first sig) (.. ~(first sig) -proto_methods ~(symbol (core/str "-" slot)))) ;; Property access needed here. 978 | (.. ~(first sig) -proto_methods (~slot ~@sig)) 979 | (let [x# (if (nil? ~(first sig)) nil ~(first sig))] 980 | ((or 981 | (aget ~(fqn fname) "_") 982 | (throw (missing-protocol 983 | ~(core/str psym "." fname) ~(first sig)))) 984 | ~@sig))))) 985 | method (fn [[fname & sigs]] 986 | (let [sigs (take-while vector? sigs) 987 | slot (symbol (core/str prefix (name fname))) 988 | fname (vary-meta fname assoc :protocol p)] 989 | `(do 990 | (set! (.. lua/basic_types_prot_functions ~(to-property fname)) (~'js* "{}")) 991 | (defn ~fname ~@(map (fn [sig] 992 | (expand-sig fname 993 | (symbol (core/str slot "__arity__" (count sig))) 994 | sig)) 995 | sigs)))))] 996 | `(do 997 | (set! ~'*unchecked-if* true) 998 | (def ~psym (lua-table)) 999 | ~@(map method methods) 1000 | (set! ~'*unchecked-if* false) 1001 | nil))) 1002 | 1003 | ;;TODO: Com back here and see if CLJS-Lua is appropriate 1004 | (defmacro implements? 1005 | "EXPERIMENTAL" 1006 | [psym x] 1007 | (let [p (:name 1008 | (cljs.terra.analyzer/resolve-var 1009 | (dissoc &env :locals) psym)) 1010 | prefix (protocol-prefix p) 1011 | xsym (bool-expr (gensym)) 1012 | [part bit] (fast-path-protocols p) 1013 | msym (symbol 1014 | (core/str "-cljs__lang__protocol_mask__partition" part "__"))] 1015 | `(let [~xsym ~x] 1016 | (if ~xsym 1017 | (let [bit# ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))] 1018 | (if (or bit# 1019 | ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix))))) 1020 | true 1021 | false)) 1022 | false)))) 1023 | 1024 | ;;TODO Come back here and see if CLJS-Lua is appropriate 1025 | (defmacro satisfies? 1026 | "Returns true if x satisfies the protocol" 1027 | [psym x] 1028 | (let [p (:name 1029 | (cljs.terra.analyzer/resolve-var 1030 | (dissoc &env :locals) psym)) 1031 | prefix (protocol-prefix p) 1032 | xsym (bool-expr (gensym)) 1033 | [part bit] (fast-path-protocols p) 1034 | msym (symbol 1035 | (core/str "-cljs__lang__protocol_mask__partition" part "__"))] 1036 | `(let [~xsym ~x] 1037 | (if ~xsym 1038 | (let [bit# ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))] 1039 | (if (or bit# 1040 | ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix))))) 1041 | true 1042 | (if (coercive-not (. ~xsym ~msym)) 1043 | (cljs.core/native-satisfies? ~psym ~xsym) 1044 | false))) 1045 | (cljs.core/native-satisfies? ~psym ~xsym))))) 1046 | 1047 | (defmacro lazy-seq [& body] 1048 | `(new cljs.core/LazySeq nil (fn [] ~@body) nil nil)) 1049 | 1050 | (defmacro delay [& body] 1051 | "Takes a body of expressions and yields a Delay object that will 1052 | invoke the body only the first time it is forced (with force or deref/@), and 1053 | will cache the result and return it on all subsequent force 1054 | calls." 1055 | `(new cljs.core/Delay (atom {:done false, :value nil}) (fn [] ~@body))) 1056 | 1057 | (defmacro with-redefs 1058 | "binding => var-symbol temp-value-expr 1059 | 1060 | Temporarily redefines vars while executing the body. The 1061 | temp-value-exprs will be evaluated and each resulting value will 1062 | replace in parallel the root value of its var. After the body is 1063 | executed, the root values of all the vars will be set back to their 1064 | old values. Useful for mocking out functions during testing." 1065 | [bindings & body] 1066 | (let [names (take-nth 2 bindings) 1067 | vals (take-nth 2 (drop 1 bindings)) 1068 | tempnames (map (comp gensym name) names) 1069 | binds (map core/vector names vals) 1070 | resets (reverse (map core/vector names tempnames)) 1071 | bind-value (fn [[k v]] (core/list 'set! k v))] 1072 | `(let [~@(interleave tempnames names)] 1073 | (try 1074 | ~@(map bind-value binds) 1075 | ~@body 1076 | (finally 1077 | ~@(map bind-value resets)))))) 1078 | 1079 | (defmacro binding 1080 | "binding => var-symbol init-expr 1081 | 1082 | Creates new bindings for the (already-existing) vars, with the 1083 | supplied initial values, executes the exprs in an implicit do, then 1084 | re-establishes the bindings that existed before. The new bindings 1085 | are made in parallel (unlike let); all init-exprs are evaluated 1086 | before the vars are bound to their new values." 1087 | [bindings & body] 1088 | (let [names (take-nth 2 bindings)] 1089 | (cljs.terra.analyzer/confirm-bindings &env names) 1090 | `(with-redefs ~bindings ~@body))) 1091 | 1092 | ;; TODO - this should be a done with `setmetatable` and a global Error table 1093 | 1094 | (defmacro error-obj 1095 | "Provides a host/platform independent way to generate errors" 1096 | [msg & data] 1097 | (apply lua-table (conj data msg :message))) 1098 | 1099 | (defmacro condp 1100 | "Takes a binary predicate, an expression, and a set of clauses. 1101 | Each clause can take the form of either: 1102 | 1103 | test-expr result-expr 1104 | 1105 | test-expr :>> result-fn 1106 | 1107 | Note :>> is an ordinary keyword. 1108 | 1109 | For each clause, (pred test-expr expr) is evaluated. If it returns 1110 | logical true, the clause is a match. If a binary clause matches, the 1111 | result-expr is returned, if a ternary clause matches, its result-fn, 1112 | which must be a unary function, is called with the result of the 1113 | predicate as its argument, the result of that call being the return 1114 | value of condp. A single default expression can follow the clauses, 1115 | and its value will be returned if no clause matches. If no default 1116 | expression is provided and no clause matches, an 1117 | IllegalArgumentException is thrown." 1118 | {:added "1.0"} 1119 | 1120 | [pred expr & clauses] 1121 | (let [gpred (gensym "pred__") 1122 | gexpr (gensym "expr__") 1123 | emit (fn emit [pred expr args] 1124 | (let [[[a b c :as clause] more] 1125 | (split-at (if (= :>> (second args)) 3 2) args) 1126 | n (count clause)] 1127 | (core/cond 1128 | (= 0 n) `(throw (js/Error. (core/str "No matching clause: " ~expr))) 1129 | (= 1 n) a 1130 | (= 2 n) `(if (~pred ~a ~expr) 1131 | ~b 1132 | ~(emit pred expr more)) 1133 | :else `(if-let [p# (~pred ~a ~expr)] 1134 | (~c p#) 1135 | ~(emit pred expr more))))) 1136 | gres (gensym "res__")] 1137 | `(let [~gpred ~pred 1138 | ~gexpr ~expr] 1139 | ~(emit gpred gexpr clauses)))) 1140 | 1141 | (defmacro case [e & clauses] 1142 | (let [default (if (odd? (count clauses)) 1143 | (last clauses) 1144 | `(throw (js/Error. (core/str "No matching clause: " ~e)))) 1145 | assoc-test (fn assoc-test [m test expr] 1146 | (if (contains? m test) 1147 | (throw (clojure.core/IllegalArgumentException. 1148 | (core/str "Duplicate case test constant '" 1149 | test "'" 1150 | (when (:line &env) 1151 | (core/str " on line " (:line &env) " " 1152 | cljs.terra.analyzer/*cljs-file*))))) 1153 | (assoc m test expr))) 1154 | pairs (reduce (fn [m [test expr]] 1155 | (core/cond 1156 | (seq? test) (reduce (fn [m test] 1157 | (let [test (if (core/symbol? test) 1158 | (core/list 'quote test) 1159 | test)] 1160 | (assoc-test m test expr))) 1161 | m test) 1162 | (core/symbol? test) (assoc-test m (core/list 'quote test) expr) 1163 | :else (assoc-test m test expr))) 1164 | {} (partition 2 clauses)) 1165 | esym (gensym)] 1166 | `(let [~esym ~e] 1167 | (cond 1168 | ~@(mapcat (fn [[m c]] `((cljs.core/= ~m ~esym) ~c)) pairs) 1169 | :else ~default)))) 1170 | 1171 | (defmacro assert 1172 | "Evaluates expr and throws an exception if it does not evaluate to 1173 | logical true." 1174 | ([x] 1175 | (when *assert* 1176 | `(when-not ~x 1177 | (throw (js/Error. 1178 | (cljs.core/str "Assert failed: " (cljs.core/pr-str '~x))))))) 1179 | ([x message] 1180 | (when *assert* 1181 | `(when-not ~x 1182 | (throw (js/Error. 1183 | (cljs.core/str "Assert failed: " ~message "\n" (cljs.core/pr-str '~x)))))))) 1184 | 1185 | (defmacro for 1186 | "List comprehension. Takes a vector of one or more 1187 | binding-form/collection-expr pairs, each followed by zero or more 1188 | modifiers, and yields a lazy sequence of evaluations of expr. 1189 | Collections are iterated in a nested fashion, rightmost fastest, 1190 | and nested coll-exprs can refer to bindings created in prior 1191 | binding-forms. Supported modifiers are: :let [binding-form expr ...], 1192 | :while test, :when test. 1193 | 1194 | (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)] [x y]))" 1195 | [seq-exprs body-expr] 1196 | (assert-args for 1197 | (vector? seq-exprs) "a vector for its binding" 1198 | (even? (count seq-exprs)) "an even number of forms in binding vector") 1199 | (let [to-groups (fn [seq-exprs] 1200 | (reduce (fn [groups [k v]] 1201 | (if (core/keyword? k) 1202 | (conj (pop groups) (conj (peek groups) [k v])) 1203 | (conj groups [k v]))) 1204 | [] (partition 2 seq-exprs))) 1205 | err (fn [& msg] (throw (ex-info (apply core/str msg) {}))) 1206 | emit-bind (fn emit-bind [[[bind expr & mod-pairs] 1207 | & [[_ next-expr] :as next-groups]]] 1208 | (let [giter (gensym "iter__") 1209 | gxs (gensym "s__") 1210 | do-mod (fn do-mod [[[k v :as pair] & etc]] 1211 | (core/cond 1212 | (= k :let) `(let ~v ~(do-mod etc)) 1213 | (= k :while) `(when ~v ~(do-mod etc)) 1214 | (= k :when) `(if ~v 1215 | ~(do-mod etc) 1216 | (recur (rest ~gxs))) 1217 | (core/keyword? k) (err "Invalid 'for' keyword " k) 1218 | next-groups 1219 | `(let [iterys# ~(emit-bind next-groups) 1220 | fs# (seq (iterys# ~next-expr))] 1221 | (if fs# 1222 | (concat fs# (~giter (rest ~gxs))) 1223 | (recur (rest ~gxs)))) 1224 | :else `(cons ~body-expr 1225 | (~giter (rest ~gxs)))))] 1226 | (if next-groups 1227 | #_ "not the inner-most loop" 1228 | `(fn ~giter [~gxs] 1229 | (lazy-seq 1230 | (loop [~gxs ~gxs] 1231 | (when-first [~bind ~gxs] 1232 | ~(do-mod mod-pairs))))) 1233 | #_"inner-most loop" 1234 | (let [gi (gensym "i__") 1235 | gb (gensym "b__") 1236 | do-cmod (fn do-cmod [[[k v :as pair] & etc]] 1237 | (core/cond 1238 | (= k :let) `(let ~v ~(do-cmod etc)) 1239 | (= k :while) `(when ~v ~(do-cmod etc)) 1240 | (= k :when) `(if ~v 1241 | ~(do-cmod etc) 1242 | (recur 1243 | (unchecked-inc ~gi))) 1244 | (core/keyword? k) 1245 | (err "Invalid 'for' keyword " k) 1246 | :else 1247 | `(do (chunk-append ~gb ~body-expr) 1248 | (recur (unchecked-inc ~gi)))))] 1249 | `(fn ~giter [~gxs] 1250 | (lazy-seq 1251 | (loop [~gxs ~gxs] 1252 | (when-let [~gxs (seq ~gxs)] 1253 | (if (chunked-seq? ~gxs) 1254 | (let [c# ^not-native (chunk-first ~gxs) 1255 | size# (count c#) 1256 | ~gb (chunk-buffer size#)] 1257 | (if (coercive-boolean 1258 | (loop [~gi 0] 1259 | (if (< ~gi size#) 1260 | (let [~bind (-nth c# ~gi)] 1261 | ~(do-cmod mod-pairs)) 1262 | true))) 1263 | (chunk-cons 1264 | (chunk ~gb) 1265 | (~giter (chunk-rest ~gxs))) 1266 | (chunk-cons (chunk ~gb) nil))) 1267 | (let [~bind (first ~gxs)] 1268 | ~(do-mod mod-pairs)))))))))))] 1269 | `(let [iter# ~(emit-bind (to-groups seq-exprs))] 1270 | (iter# ~(second seq-exprs))))) 1271 | 1272 | (defmacro doseq 1273 | "Repeatedly executes body (presumably for side-effects) with 1274 | bindings and filtering as provided by \"for\". Does not retain 1275 | the head of the sequence. Returns nil." 1276 | [seq-exprs & body] 1277 | (assert-args doseq 1278 | (vector? seq-exprs) "a vector for its binding" 1279 | (even? (count seq-exprs)) "an even number of forms in binding vector") 1280 | (let [err (fn [& msg] (throw (ex-info (apply core/str msg) {}))) 1281 | step (fn step [recform exprs] 1282 | (if-not exprs 1283 | [true `(do ~@body)] 1284 | (let [k (first exprs) 1285 | v (second exprs) 1286 | 1287 | seqsym (gensym "seq__") 1288 | recform (if (core/keyword? k) recform `(recur (next ~seqsym) nil 0 0)) 1289 | steppair (step recform (nnext exprs)) 1290 | needrec (steppair 0) 1291 | subform (steppair 1)] 1292 | (core/cond 1293 | (= k :let) [needrec `(let ~v ~subform)] 1294 | (= k :while) [false `(when ~v 1295 | ~subform 1296 | ~@(when needrec [recform]))] 1297 | (= k :when) [false `(if ~v 1298 | (do 1299 | ~subform 1300 | ~@(when needrec [recform])) 1301 | ~recform)] 1302 | (core/keyword? k) (err "Invalid 'doseq' keyword" k) 1303 | :else (let [chunksym (with-meta (gensym "chunk__") 1304 | {:tag 'not-native}) 1305 | countsym (gensym "count__") 1306 | isym (gensym "i__") 1307 | recform-chunk `(recur ~seqsym ~chunksym ~countsym (unchecked-inc ~isym)) 1308 | steppair-chunk (step recform-chunk (nnext exprs)) 1309 | subform-chunk (steppair-chunk 1)] 1310 | [true `(loop [~seqsym (seq ~v) 1311 | ~chunksym nil 1312 | ~countsym 0 1313 | ~isym 0] 1314 | (if (coercive-boolean (< ~isym ~countsym)) 1315 | (let [~k (-nth ~chunksym ~isym)] 1316 | ~subform-chunk 1317 | ~@(when needrec [recform-chunk])) 1318 | (when-let [~seqsym (seq ~seqsym)] 1319 | (if (chunked-seq? ~seqsym) 1320 | (let [c# (chunk-first ~seqsym)] 1321 | (recur (chunk-rest ~seqsym) c# 1322 | (count c#) 0)) 1323 | (let [~k (first ~seqsym)] 1324 | ~subform 1325 | ~@(when needrec [recform]))))))])))))] 1326 | (nth (step nil (seq seq-exprs)) 1))) 1327 | 1328 | (defmacro array [& rest] 1329 | (let [xs-str (->> (repeat "~{}") 1330 | (take (count rest)) 1331 | (interpose ",") 1332 | (apply core/str))] 1333 | (vary-meta 1334 | (list* 'js* (core/str "[" xs-str "]") rest) 1335 | assoc :tag 'array))) 1336 | 1337 | (defmacro make-array 1338 | [size] 1339 | (vary-meta 1340 | (if (core/number? size) 1341 | `(array ~@(take size (repeat nil))) 1342 | `(js/Array. ~size)) 1343 | assoc :tag 'array)) 1344 | 1345 | (defmacro list 1346 | ([] `cljs.core.List.EMPTY) 1347 | ([x & xs] 1348 | `(-conj (list ~@xs) ~x))) 1349 | 1350 | (defmacro vector 1351 | ([] `cljs.core.PersistentVector.EMPTY) 1352 | ([& xs] 1353 | (let [cnt (count xs)] 1354 | (if (core/< cnt 32) 1355 | `(cljs.core.PersistentVector. nil ~cnt 5 1356 | cljs.core.PersistentVector.EMPTY_NODE (array ~@xs) nil) 1357 | (vary-meta 1358 | `(cljs.core.PersistentVector.fromArray (array ~@xs) true) 1359 | assoc :tag 'cljs.core/PersistentVector))))) 1360 | 1361 | (defmacro array-map 1362 | ([] `cljs.core.PersistentArrayMap.EMPTY) 1363 | ([& kvs] 1364 | (core/cond 1365 | (core/> (count kvs) 16) 1366 | `(hash-map ~@kvs) 1367 | 1368 | (let [keys (map first (partition 2 kvs))] 1369 | (core/and (every? #(= (:op %) :constant) 1370 | (map #(cljs.terra.analyzer/analyze &env %) keys)) 1371 | (= (count (into #{} keys)) (count keys)))) 1372 | `(cljs.core.PersistentArrayMap. nil ~(clojure.core// (count kvs) 2) (array ~@kvs) nil) 1373 | 1374 | :else 1375 | `(cljs.core.PersistentArrayMap.fromArray (array ~@kvs) true false)))) 1376 | 1377 | (defmacro hash-map 1378 | ([] `cljs.core.PersistentHashMap.EMPTY) 1379 | ([& kvs] 1380 | (let [pairs (partition 2 kvs) 1381 | ks (map first pairs) 1382 | vs (map second pairs)] 1383 | (vary-meta 1384 | `(cljs.core.PersistentHashMap.fromArrays (array ~@ks) (array ~@vs)) 1385 | assoc :tag 'cljs.core/PersistentHashMap)))) 1386 | 1387 | (defmacro hash-set 1388 | ([] `cljs.core.PersistentHashSet.EMPTY) 1389 | ([& xs] 1390 | (if (core/and (core/<= (count xs) 8) 1391 | (every? #(= (:op %) :constant) 1392 | (map #(cljs.terra.analyzer/analyze &env %) xs)) 1393 | (= (count (into #{} xs)) (count xs))) 1394 | `(cljs.core.PersistentHashSet. nil 1395 | (cljs.core.PersistentArrayMap. nil ~(count xs) (array ~@(interleave xs (repeat nil))) nil) 1396 | nil) 1397 | (vary-meta 1398 | `(cljs.core.PersistentHashSet.fromArray (array ~@xs) true) 1399 | assoc :tag 'cljs.core/PersistentHashSet)))) 1400 | 1401 | (defn js-obj* [kvs] 1402 | (let [kvs-str (->> (repeat "[~{}]=~{}") 1403 | (take (count kvs)) 1404 | (interpose ",") 1405 | (apply core/str))] 1406 | (vary-meta 1407 | (list* 'host* (core/str "({" kvs-str "})") (apply concat kvs)) 1408 | assoc :tag 'object))) ;; TODO: Should the tag be 'table ? 1409 | 1410 | (defmacro js-obj [& rest] 1411 | (let [sym-or-str? (fn [x] (core/or (core/symbol? x) (core/string? x))) 1412 | filter-on-keys (fn [f coll] 1413 | (->> coll 1414 | (filter (fn [[k _]] (f k))) 1415 | (into {}))) 1416 | kvs (into {} (map vec (partition 2 rest))) 1417 | sym-pairs (filter-on-keys core/symbol? kvs) 1418 | expr->local (zipmap 1419 | (filter (complement sym-or-str?) (keys kvs)) 1420 | (repeatedly gensym)) 1421 | obj (gensym "obj")] 1422 | `(let [~@(apply concat (clojure.set/map-invert expr->local)) 1423 | ~obj ~(js-obj* (filter-on-keys core/string? kvs))] 1424 | ~@(map (fn [[k v]] `(aset ~obj ~k ~v)) sym-pairs) 1425 | ~@(map (fn [[k v]] `(aset ~obj ~v ~(core/get kvs k))) expr->local) 1426 | ~obj))) 1427 | 1428 | (def lua-table js-obj) 1429 | 1430 | (defmacro alength [a] 1431 | (vary-meta 1432 | (core/list 'host* "(~{}).length" a) 1433 | assoc :tag 'number)) 1434 | 1435 | (defmacro amap 1436 | "Maps an expression across an array a, using an index named idx, and 1437 | return value named ret, initialized to a clone of a, then setting 1438 | each element of ret to the evaluation of expr, returning the new 1439 | array ret." 1440 | [a idx ret expr] 1441 | `(let [a# ~a 1442 | ~ret (aclone a#)] 1443 | (loop [~idx 0] 1444 | (if (< ~idx (alength a#)) 1445 | (do 1446 | (aset ~ret ~idx ~expr) 1447 | (recur (inc ~idx))) 1448 | ~ret)))) 1449 | 1450 | (defmacro areduce 1451 | "Reduces an expression across an array a, using an index named idx, 1452 | and return value named ret, initialized to init, setting ret to the 1453 | evaluation of expr at each step, returning ret." 1454 | [a idx ret init expr] 1455 | `(let [a# ~a] 1456 | (loop [~idx 0 ~ret ~init] 1457 | (if (< ~idx (alength a#)) 1458 | (recur (inc ~idx) ~expr) 1459 | ~ret)))) 1460 | 1461 | (defmacro dotimes 1462 | "bindings => name n 1463 | 1464 | Repeatedly executes body (presumably for side-effects) with name 1465 | bound to integers from 0 through n-1." 1466 | [bindings & body] 1467 | (let [i (first bindings) 1468 | n (second bindings)] 1469 | `(let [n# ~n] 1470 | (loop [~i 0] 1471 | (when (< ~i n#) 1472 | ~@body 1473 | (recur (inc ~i))))))) 1474 | 1475 | (defn ^:private check-valid-options 1476 | "Throws an exception if the given option map contains keys not listed 1477 | as valid, else returns nil." 1478 | [options & valid-keys] 1479 | (when (seq (apply disj (apply core/hash-set (keys options)) valid-keys)) 1480 | (throw 1481 | (apply core/str "Only these options are valid: " 1482 | (first valid-keys) 1483 | (map #(core/str ", " %) (rest valid-keys)))))) 1484 | 1485 | (defmacro defmulti 1486 | "Creates a new multimethod with the associated dispatch function. 1487 | The docstring and attribute-map are optional. 1488 | 1489 | Options are key-value pairs and may be one of: 1490 | :default the default dispatch value, defaults to :default 1491 | :hierarchy the isa? hierarchy to use for dispatching 1492 | defaults to the global hierarchy" 1493 | [mm-name & options] 1494 | (let [docstring (if (core/string? (first options)) 1495 | (first options) 1496 | nil) 1497 | options (if (core/string? (first options)) 1498 | (next options) 1499 | options) 1500 | m (if (map? (first options)) 1501 | (first options) 1502 | {}) 1503 | options (if (map? (first options)) 1504 | (next options) 1505 | options) 1506 | dispatch-fn (first options) 1507 | options (next options) 1508 | m (if docstring 1509 | (assoc m :doc docstring) 1510 | m) 1511 | m (if (meta mm-name) 1512 | (conj (meta mm-name) m) 1513 | m)] 1514 | (when (= (count options) 1) 1515 | (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))) 1516 | (let [options (apply core/hash-map options) 1517 | default (core/get options :default :default)] 1518 | (check-valid-options options :default :hierarchy) 1519 | `(def ~(with-meta mm-name m) 1520 | (let [method-table# (atom {}) 1521 | prefer-table# (atom {}) 1522 | method-cache# (atom {}) 1523 | cached-hierarchy# (atom {}) 1524 | hierarchy# (get ~options :hierarchy (cljs.core/get-global-hierarchy))] 1525 | (cljs.core/MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy# 1526 | method-table# prefer-table# method-cache# cached-hierarchy#)))))) 1527 | 1528 | (defmacro defmethod 1529 | "Creates and installs a new method of multimethod associated with dispatch-value. " 1530 | [multifn dispatch-val & fn-tail] 1531 | `(-add-method ~(with-meta multifn {:tag 'cljs.core/MultiFn}) ~dispatch-val (fn ~@fn-tail))) 1532 | 1533 | (defmacro time 1534 | "Evaluates expr and prints the time it took. Returns the value of expr." 1535 | [expr] 1536 | `(let [start# (.getTime (js/Date.)) 1537 | ret# ~expr] 1538 | (prn (core/str "Elapsed time: " (- (.getTime (js/Date.)) start#) " msecs")) 1539 | ret#)) 1540 | 1541 | (defmacro simple-benchmark 1542 | "Runs expr iterations times in the context of a let expression with 1543 | the given bindings, then prints out the bindings and the expr 1544 | followed by number of iterations and total time. The optional 1545 | argument print-fn, defaulting to println, sets function used to 1546 | print the result. expr's string representation will be produced 1547 | using pr-str in any case." 1548 | [bindings expr iterations & {:keys [print-fn] :or {print-fn 'println}}] 1549 | (let [bs-str (pr-str bindings) 1550 | expr-str (pr-str expr)] 1551 | `(let ~bindings 1552 | (let [start# (.getTime (js/Date.)) 1553 | ret# (dotimes [_# ~iterations] ~expr) 1554 | end# (.getTime (js/Date.)) 1555 | elapsed# (- end# start#)] 1556 | (~print-fn (str ~bs-str ", " ~expr-str ", " 1557 | ~iterations " runs, " elapsed# " msecs")))))) 1558 | 1559 | (def cs (into [] (map (comp symbol core/str core/char) (range 97 118)))) 1560 | 1561 | (defn gen-apply-to-helper 1562 | ([] (gen-apply-to-helper 1)) 1563 | ([n] 1564 | (let [prop (symbol (core/str "-cljs__core__IFn___invoke__arity__" n)) 1565 | f (symbol (core/str "cljs__core__IFn___invoke__arity__" n))] 1566 | (if (core/<= n 20) 1567 | `(let [~(cs (core/dec n)) (-first ~'args) 1568 | ~'args (-rest ~'args)] 1569 | (if (core/== ~'argc ~n) 1570 | (if (. ~'f ~prop) 1571 | (. ~'f (~f ~@(take n cs))) 1572 | (~'f ~@(take n cs))) 1573 | ~(gen-apply-to-helper (core/inc n)))) 1574 | `(throw (js/Error. "Only up to 20 arguments supported on functions")))))) 1575 | 1576 | (defmacro gen-apply-to [] 1577 | `(do 1578 | (set! ~'*unchecked-if* true) 1579 | (defn ~'apply-to [~'f ~'argc ~'args] 1580 | (let [~'args (seq ~'args)] 1581 | (if (zero? ~'argc) 1582 | (~'f) 1583 | ~(gen-apply-to-helper)))) 1584 | (set! ~'*unchecked-if* false))) 1585 | 1586 | (defmacro with-out-str 1587 | "Evaluates exprs in a context in which *print-fn* is bound to .append 1588 | on a fresh StringBuffer. Returns the string created by any nested 1589 | printing calls." 1590 | [& body] 1591 | `(let [sb# (goog.string/StringBuffer.)] 1592 | (binding [cljs.core/*print-fn* (fn [x#] (.append sb# x#))] 1593 | ~@body) 1594 | (cljs.core/str sb#))) 1595 | 1596 | (defmacro lazy-cat 1597 | "Expands to code which yields a lazy sequence of the concatenation 1598 | of the supplied colls. Each coll expr is not evaluated until it is 1599 | needed. 1600 | 1601 | (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))" 1602 | [& colls] 1603 | `(concat ~@(map #(core/list `lazy-seq %) colls))) 1604 | --------------------------------------------------------------------------------