├── .gitignore ├── LICENSE ├── README.md ├── project.clj ├── src └── mixfix │ ├── clj.clj │ └── clj │ ├── core.clj │ └── parser.clj └── test └── mixfix └── clj ├── assoc_test.clj ├── core_test.clj ├── parser_test.clj ├── redirs_all_test.clj ├── redirs_test.clj └── sql_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | bin/ 12 | *~ 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # mixfix-clj 2 | 3 | Provides mixfix syntax for Clojure language. 4 | 5 | It simply allows writing Clojure expressions like this: 6 | 7 | ```clojure 8 | 9 | (defn myfun [x y] 10 | (if x < 2 then x + y - 1 else (x + y) * 2)) 11 | 12 | ``` 13 | 14 | You can also easily define nice syntax of your next EDSL. 15 | 16 | For example some SQL-like 17 | 18 | ```clojure 19 | (exec (select * from table1, table2 where col1 < col2 group by col1, col2)) 20 | ``` 21 | 22 | The `exec` there is user-defined macros. It uses this library 23 | `mixfix.clj.core\parse` function to convert concrete SQL-like 24 | syntax into abstract syntax tree. This tree is plain Clojure form, and it easy 25 | to analyze or execute or convert into some DBMS query syntax using standard 26 | Clojure means, like `clojure.walk`. 27 | 28 | This is just simple macros, no extra build steps are required. 29 | 30 | ## Usage 31 | 32 | Install it using Clojars: 33 | 34 | [![Clojars Project](http://clojars.org/mixfix-clj/latest-version.svg)](http://clojars.org/mixfix-clj) 35 | 36 | Import the library: 37 | 38 | ```clojure 39 | (ns sample.mixfix 40 | (:require [mixfix.clj :as m])) 41 | ``` 42 | 43 | or for ClojureScript 44 | 45 | ```clojure 46 | (ns sample.mixfix 47 | (:require-macros [mixfix.clj :as m])) 48 | ``` 49 | 50 | Now define some operators: 51 | 52 | ```clojure 53 | 54 | (m/op 400 + [[] + [+]]) 55 | (m/op 400 - [[] - [+]]) 56 | (m/op 500 * [[] * [+]]) 57 | (m/op 500 / [[] / [+]]) 58 | (m/op 200 or [[] or [+]]) 59 | (m/op 300 and [[] and [+]]) 60 | (m/op 400 = [[] is []]) 61 | (m/op 100 if [if [+] then []]) 62 | (m/op 110 if [if [+] then [] else []]) 63 | ``` 64 | 65 | And use them: 66 | 67 | ```clojure 68 | 69 | 70 | (m/% 2 + 2) ; ==> 4 71 | (m/% 2 - 2 - 2) ; ==> -2 72 | (m/% 2 - (2 - 2)); ==> 2 73 | (m/% let [x 2 y 2] (x + y - 2)); ==> 2 74 | (m/% if 2 is 2 then if 3 is 4 then 5 else 6); ==> 6 75 | 76 | ;; it also composes with plain clojure application forms: 77 | 78 | (m/% 2 + (- 2 2)) ; ==> 2 79 | 80 | ``` 81 | 82 | The arguments for `op` are: 83 | 84 | 1. optional language name 85 | 2. precedence level, the bigger the number the tightly the operator binds 86 | 3. head symbol for clojure application list the operator will be converted to 87 | 4. syntax picture 88 | 89 | Syntax picture is a vector of symbols interleaved with another vectors 90 | specifying syntax holes. The hole definition vector may contain various options. 91 | In the current version they may be either: 92 | 93 | * `empty` - means same precedence level as its operator 94 | * `number` - specifies any precedence explicitly 95 | * `+` - precedence is precendence of the operator plus one 96 | * `assoc` - will unwrap sub-form if it has same head symbol as the operator 97 | * `id ` - for assoc operators will treat as identity for the 98 | operation, by default `nil`. 99 | 100 | So this is it. Mixfix operators are converted into plain clojure application 101 | form using ` %` macros. It walks through all sub-forms and parses their content 102 | too. There is also shallow version `%1` which parses only a single level. 103 | 104 | There is also `mixfix.clj/defn` macros which simply redirects to 105 | `clojure.core/defn` but wraps arguments with operators parsing macros. 106 | 107 | Plain clojure application may be also converted back into mixfix syntax. 108 | 109 | ```clojure 110 | 111 | (m/to-mixfix (- (+ (- (+ 1 2) 3) 4) 5))); ==> (1 + 2 - 3 + 4 - 5) 112 | 113 | ``` 114 | 115 | It matches syntax definitions by arity, so if there are ambiguous symbol name 116 | plus arity it may fail to do this property. 117 | 118 | ## Associative operators 119 | 120 | Clojure often permits many arguments in an expression for typically binary 121 | operators, such as `clojure.core/+` etc. The library can handle such operators 122 | too. For this in the vector of syntax hole definition add `assoc` option and 123 | optionally identity symbol for that operation. For example for addition: 124 | 125 | ```clojure 126 | 127 | (op 400 + [[assoc id 0] + [+]]) 128 | 129 | ; now + will be parsed into single `+` form 130 | 131 | (macroexpand '(r/% 1 + 2 + 3)) ; ==> (+ 1 2 3) 132 | (macroexpand '(r/% 0 + 1)) ; ==> (+ 1) 133 | 134 | ``` 135 | 136 | This isn't useful much for arithmetic operators unless generated code must 137 | be readable. But it is useful for example for `clojure.core/list`. 138 | 139 | ## Interleaving with clojure applications 140 | There are two ways to use plain clojure application forms inside mixfix syntax. 141 | By default there is an operator for space or comma (and it is the only 142 | predefined operator in this version of the library). 143 | 144 | ```clojure 145 | 146 | (op 1000 form [[assoc] [+]]) 147 | 148 | ``` 149 | 150 | The library provides an auxiliary macros `mixfix.clj.core/form` it 151 | simply splices its arguments in a list without doing with them anything. So as 152 | a result it will be plain clojure application. For example 153 | 154 | ```clojure 155 | 156 | (m/op 200 if [if [+] then []]) 157 | 158 | (clojure.walk/macroexpand-all '(% if = 2 2 then :t)) 159 | ; ==> (if (= 2 2) (do :t)) 160 | 161 | ``` 162 | 163 | This option may be not convenient to detect syntax error sometimes, for example 164 | if we define "==" operator but accidently use "=" instead. 165 | 166 | ```clojure 167 | (clojure.walk/macroexpand-all '(% if 2 = 2 then :t)) 168 | ; ==> (if (2 = 2) (do :t)) 169 | ``` 170 | 171 | And clojure will complain about "2" isn't function, and this may be confusing. 172 | This is an issue only for operators clashing with predefined function or macros 173 | names in scope. The library will only accept them if it can `clojure.core/resolve` 174 | all the items of the list. It is also possible to disable such behavior by 175 | removing such operator with: 176 | 177 | ```clojure 178 | (m/remove-op form) 179 | ``` 180 | 181 | In this case clojure plain application can still be parsed but it must be in 182 | parens. This is a kind of parenthesis symbols overloading. They may be used for 183 | grouping mixfix sub-expressions and for specify clojure applications. 184 | 185 | ```clojure 186 | (clojure.walk/macroexpand-all '(% if (= 2 2) then :t)) 187 | ; ==> (if (2 = 2) (do :t)) 188 | ``` 189 | 190 | After the library detected parser error within parens it will try to interpret 191 | them as a plain clojure list. Library will conclude the form is ok if all 192 | symbols there can be resolved. This behavior may be also turned off using 193 | `mixfix.clj.core/*clojure-apps*` dynamic variable if your EDSL 194 | doesn't need it. After only mixfix predefined operators can be present in 195 | parsed expression. 196 | 197 | Another thing may be useful for custom EDSL, is `mixfix.clj.core/*locals*` 198 | variable, which is a set of symbols bound to some local variable in a form 199 | currently parsed. By default it is inited from &env parameter, but for custom 200 | EDSL, if it has some custom bound names they must be added to the set. 201 | 202 | ## Syntax scopes 203 | 204 | If some operators belong only to some EDSL (passed as parameters to some macros) 205 | they may be assigned to some named scope. This scope can be used in parse 206 | function to convert it to plain clojure form for further handling by EDSL 207 | implementation. 208 | 209 | Such scope is defined using `mixfix.clj.core/declare-lang` macros. The 210 | first parameter is a name of the scope. The second optional parameter is another 211 | scope where initial operators' definitions are to be copied from. It creates 212 | a variable with the same name which is used for referencing the scope. It may be 213 | passed as the optional first argument in `op` directives. And it may be passed 214 | to `mixfix.clj.core/parse` function via dynamic variable 215 | `mixfix.clj.core/*lang*` form the macro receiving EDSL expressions as 216 | parameters. Variable `mixfix.clj.core/global` is used as default 217 | scope. There is also corresponding macros `%*` with additional parameter for the 218 | scope specification. 219 | 220 | For example defining SQL-like syntax: 221 | 222 | ```clojure 223 | (m/declare-lang sql) 224 | (m/op sql 100 select [select [+] from [+] where [+] group by [+]]) 225 | (m/op sql 100 select [select [+] from [+] where [+]]) 226 | (m/op sql 100 select [select [+] from [+]]) 227 | (m/op sql 200 list [[assoc] [+]]) 228 | (m/op sql 150 = [[+] = [+]]) 229 | (m/op sql 150 < [[+] < [+]]) 230 | ; ...... 231 | 232 | ``` 233 | 234 | It looks a bit verbose, especially if the language size will grow. But, since 235 | `op` there is only a macros (not clojure syntax part), it may be easily 236 | generated. Or some next version will provide picture syntax for this. 237 | 238 | These syntax further is parsed into AST with `mixfix.clj.core/parse` 239 | function with `mixfix.clj.core/*lang*` variable bound to `sql` 240 | variable. 241 | 242 | ## Limitations 243 | 244 | If some library implements its own EDSL syntax parser it will not compose well 245 | with this library. An example is `clojure.test/is`. It may take expected 246 | exception thrown specification with `thrown?` keyword. It is not a macros and 247 | it is not a function. It is just a part of another language `clojure.test/is` 248 | can understand. On the other hand mixfix-clj doesn't know anything about this 249 | keyword. So it will report parser error. It could ignore this and leave the 250 | form as is but it would significantly reduce diagnostic capabilities. There is 251 | a macros for registering such kind of keywords (namely 252 | `mixfix.clj.core/reg-sym`). But even registered it won't work anyway. 253 | Not the problem is ordering of macros expansion. But if the library also uses 254 | mixfix-clj for syntax parsing it should work without problems. 255 | 256 | At the moment there is no namespaces support for operator's part. They are 257 | simply compared by `clojure.core/name`. But their support is planned for some 258 | next version. This will be another level of operations scoping. 259 | 260 | ## TODO: 261 | 262 | * bindings (now only clojure subforms such as let, or fn will be considered) 263 | * better diagnostics 264 | 265 | ## License 266 | 267 | Copyright © 2015 Vitaliy Akimov 268 | 269 | Distributed under the Eclipse Public License either version 1.0 or (at 270 | your option) any later version. 271 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject mixfix-clj "0.3.0-SNAPSHOT" 2 | :description "mixfix operators syntax for clojure" 3 | :url "https://github.com/awto/mixfix-clj" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.7.0"] [org.clojure/clojurescript "1.7.48"]]) 7 | -------------------------------------------------------------------------------- /src/mixfix/clj.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj 2 | (:refer-clojure :exclude [defn]) 3 | (:require [clojure.core :as c] [mixfix.clj.core :as %])) 4 | 5 | (defmacro defn 6 | "Same as clojure.core/defn but unwraps mixfix operators" 7 | [& ops] 8 | `(c/defn ~@(%/propagate-% ops))) 9 | 10 | (defmacro op [& args] `(%/op ~@args)) 11 | (defmacro % [& args] `(%/% ~@args)) 12 | (defmacro %* [& args] `(%/%* ~@args)) 13 | (defmacro remove-op [& args] `(%/remove-op ~@args)) 14 | (defmacro %* [& args] `(%/%* ~@args)) 15 | 16 | nil 17 | -------------------------------------------------------------------------------- /src/mixfix/clj/core.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.core 2 | (:require [mixfix.clj.parser :as r] 3 | [clojure.walk :as w] 4 | cljs.analyzer)) 5 | 6 | (defmacro declare-lang 7 | "Defines a name which may be used to specify scopes of mixfix operators. 8 | The second optional arguments specifies which language to copy initial 9 | definitions from. The definitions are copied only once." 10 | ([nm] `(def ~nm (atom {}))) 11 | ([nm par] `(def ~nm (atom @~par)))) 12 | 13 | (declare-lang global) 14 | 15 | (def ^:dynamic *clojure-dialect* "Clojure dialect name" :clj) 16 | 17 | (def ^:dynamic *lang* 18 | "specifies current language" 19 | global) 20 | 21 | (defn- hole-opts [opts] 22 | (->> opts (partition 2 1) (map vec) (into {}))) 23 | 24 | (defn- picture-arity [picture] 25 | (count (filter map? picture))) 26 | 27 | (defn- lang-def? [d] (and (:read d) (:write d))) 28 | 29 | (defn- compile-hole [prec opts] 30 | (let [[pre [_ ids & post]] (split-with #(not= :id (keyword %)) opts) 31 | opts (->> (concat pre post) (map (some-fn keyword identity)) set) 32 | [pname & nprec] (filter (some-fn #{:+} number?) opts) 33 | _ (when-not (empty? nprec) 34 | (throw (IllegalArgumentException. 35 | (format "only single precidence is allowed in %s" opts)))) 36 | prec (cond 37 | (number? pname) pname 38 | (nil? pname) prec 39 | :else (inc prec)) 40 | asc (contains? opts :assoc) 41 | rst (vec (remove (some-fn #{:+ :assoc} number?) opts)) 42 | cut (contains? opts :!)] 43 | (when-not (empty? rst) 44 | (throw (IllegalArgumentException. 45 | (format "unknown items in syntax hole definition %s" rst)))) 46 | [{:prec prec :cut cut} asc ids])) 47 | 48 | (defn- compile-picture 49 | [prec picture] {:pre [(number? prec)]} 50 | (let [nprec (inc prec) 51 | asc (volatile! nil) 52 | tpict (for [i picture] (if (coll? i) (compile-hole prec i) i)) 53 | rpict (for [i tpict] (if (coll? i) (first i) i)) 54 | [asc & ascr] (->> tpict (filter coll?) 55 | (keep-indexed #(if (second %2) [%1 (last %2)]))) 56 | _ (when-not (empty? ascr) 57 | (throw (IllegalArgumentException. 58 | (format 59 | "only a single assoc option is allowed %s" 60 | picture))))] 61 | [(vec rpict) asc])) 62 | 63 | (defn- print-group-pict [xf] 64 | (let [buf (volatile! [])] 65 | (fn 66 | ([] (xf)) 67 | ([result] (xf [result @buf])) 68 | ([result input] 69 | (if (map? input) 70 | (let [cur @buf] 71 | (vreset! buf []) 72 | (xf result [cur input])) 73 | (do 74 | (vswap! buf conj input) 75 | result)))))) 76 | 77 | (defn- print-compile-pict [pict] {:pre [(not (empty? pict))]} 78 | (transduce print-group-pict conj pict)) 79 | 80 | (def ^:dynamic ^:private *prec* 0) 81 | 82 | (defn- add-parens [prec col] 83 | (if (< prec *prec*) [(apply list col)] 84 | (vec col))) 85 | 86 | (defn print-from-table 87 | "Converts plain clojure form into a form with mixfix operators." 88 | [table col] {:pre [(coll? col)]} 89 | (if (<= (count col) 1) 90 | [col] 91 | (let [[head & args] col 92 | arity (count args) 93 | outarg (fn [arg [pfx aprec]] 94 | (if (seq? arg) 95 | (concat pfx 96 | (binding [*prec* (:prec aprec)] 97 | (print-from-table table arg))) 98 | (conj pfx arg))) 99 | iter (fn [prec args pict tail] 100 | (add-parens prec (concat (mapcat outarg args pict) tail)))] 101 | (if-let [[prec [pict tail]] 102 | (get-in table [head arity])] 103 | (iter prec args pict tail) 104 | (if-let [[prec [pict tail oparity pos empv]] 105 | (get-in table [head '*])] 106 | (let [[pre nxt] (split-at pos args) 107 | len (- arity oparity -1)] 108 | (if (neg? len) col 109 | (let [[inner post] (split-at len nxt) 110 | inner (cond 111 | (zero? len) empv 112 | (== len 1) (first inner) 113 | :else (list* head inner)) 114 | args (concat pre [inner] post)] 115 | (iter prec args pict tail)))) 116 | col))))) 117 | 118 | (defn- get-assoc [picture] 119 | (let [[[x [_ _ opt]] & rst] 120 | (filter #(some-> % second second name #{"assoc"}) 121 | (map-indexed list (filter vector? picture)))] 122 | (when rst 123 | (throw (IllegalArgumentException. "only one assoc spec is allowed"))) 124 | (if x [x opt]))) 125 | 126 | (defn- do-add-op [table prec symbol pict] 127 | (let [[cpict asc] (compile-picture prec pict) 128 | arity (picture-arity cpict) 129 | ppict (print-compile-pict cpict) 130 | fun (if-let [[ix iden] asc] 131 | (fn [& args] 132 | (let [[pre [cur & post]] (split-at ix args)] 133 | (cons symbol 134 | (if (= iden cur) 135 | (concat pre post) 136 | (if (and (coll? cur) (= (first cur) symbol)) 137 | (concat pre (rest cur) post) 138 | args))))) 139 | (fn [& args] (cons symbol args))) 140 | [arity popts] (if-let [[ix iden] asc] 141 | ['* (concat ppict [arity ix iden])] 142 | [arity ppict])] 143 | (-> table 144 | (update-in [:read prec] (partial apply assoc) [cpict fun]) 145 | (assoc-in [:write symbol arity] [prec popts]) 146 | (update-in [:origin] conj [prec symbol pict]) 147 | (assoc-in [:clj] nil) 148 | (assoc-in [:cljs] nil)))) 149 | 150 | (defn- add-ops [table ops] 151 | (reduce (fn [table op] (apply (partial do-add-op table) op)) table ops)) 152 | 153 | (defn- del-op [table symbol] 154 | (add-ops {} (remove #(= (name symbol) (name (second %))) (:origin table)))) 155 | 156 | (defn add-op [prec picture symbol] 157 | (swap! *lang* do-add-op prec picture symbol)) 158 | 159 | (defn rm-op [symbol] (swap! *lang* del-op symbol)) 160 | 161 | (defmacro op 162 | "Defines mixfix operator. First optional argument is a name for the 163 | operator's scope. The second is precedence level of the operator. The bigger 164 | the number the tightly the operator binds. The third is resulting form head 165 | symbol. And the last one is a mixfix picture of the operator." 166 | ([lang prec symbol picture] 167 | (binding [*lang* @(resolve &env lang)] (add-op prec symbol picture) nil)) 168 | ([prec symbol picture] (add-op prec symbol picture) nil)) 169 | 170 | (defmacro remove-op 171 | "removes all operators which output forms with this head symbol" 172 | ([lang symbol] (binding [*lang* @(resolve &env lang)] 173 | (rm-op symbol) nil)) 174 | ([symbol] (rm-op symbol) nil)) 175 | 176 | (def ^:dynamic *locals* 177 | "Specifies locally defined symbols, 178 | so they are not considered to be syntax part." 179 | #{}) 180 | 181 | (def ^:dynamic ^:private *keywords* #{}) 182 | 183 | (def ^:private specials (atom #{})) 184 | 185 | (defmacro reg-sym 186 | "Adds a symbol to a list of known reserved words. For which are not local or 187 | cannot be resolved (some other library EDSL symbols)." 188 | [n] (swap! specials conj n) 'nil) 189 | 190 | (reg-sym do) 191 | 192 | (defn- check-locals [n] (*locals* n)) 193 | 194 | (defn- prim?-def [] (every-pred 195 | (complement *keywords*) 196 | (some-fn (complement symbol?) 197 | check-locals 198 | (case *clojure-dialect* 199 | :cljs (partial cljs.analyzer/resolve-var nil) 200 | :clj (partial resolve))))) 201 | 202 | (def ^:dynamic prim? prim?-def) 203 | 204 | (defn prim [] (r/guard r/any (prim?))) 205 | (defn clj-mixfix 206 | "builds mixfix expression table with clojure syntax" 207 | [table] 208 | (binding 209 | [*keywords* (set (for [[_ i] table [j _] i k j :when (symbol? k)] k))] 210 | (r/exp-table table (prim)))) 211 | 212 | (defn describe-lang 213 | ([] (:origin @*lang*)) 214 | ([lang] (:origin @lang))) 215 | 216 | (defn- get-parser [] 217 | (let [ldef @*lang*] 218 | (or (*clojure-dialect* ldef) 219 | (let [res (clj-mixfix (:read ldef))] 220 | (swap! *lang* assoc *clojure-dialect* res) 221 | res)))) 222 | 223 | (def ^:dynamic *clojure-apps* 224 | "Defines if the library should try to fallback to plain clojure forms parsing" 225 | true) 226 | 227 | (defn parse 228 | "Parses 1 level syntax with mixfix operators. Returns plain clojure form 229 | without them if succeed." 230 | [col] 231 | (let [prim-check (prim?)] 232 | (if (< (count col) 2) 233 | (apply list col) 234 | (let [parser (get-parser) 235 | r (r/run parser col)] 236 | (cond 237 | (empty? r) (if (and *clojure-apps* (every? prim-check col)) 238 | col 239 | ;'(str (format "no parse for: %s" col)) 240 | (throw (IllegalArgumentException. 241 | (format "no parse for: %s" col)))) 242 | (= 1 (count r)) (first r) 243 | :else (throw (IllegalArgumentException. 244 | (format "%s is ambiguous, options are: %s" col r)))))))) 245 | 246 | (defn parse-all 247 | "Deep version of `parse`. Parses also inside sub-forms." 248 | [col] 249 | (w/prewalk #(if (list? %) (parse %) %) col)) 250 | 251 | (defmacro %1 252 | "Shallow version of %." 253 | [& col] 254 | (let [f (binding [*locals* (into @specials (keys &env)) 255 | *clojure-dialect* (if (:ns &env) :cljs :clj)] 256 | (parse col))] 257 | `(~@f))) 258 | 259 | (defn propagate-% 260 | ([v] 261 | (w/prewalk (fn [i] (if (list? i) (cons (var %1) i) i)) v)) 262 | ([lang v] (w/prewalk (fn [i] (if (list? i) (list* '%1* lang i) i)) v))) 263 | 264 | (defmacro % 265 | "Transforms form and its subforms into clojure syntax without mixfix ops and 266 | evaluate it." 267 | [& f] 268 | `(%1 ~@(propagate-% (vec f)))) 269 | 270 | ;;; specifying custom language 271 | (defmacro %1* 272 | "Shallow version of %*." 273 | [lang & col] 274 | (let [f (binding [*locals* (into @specials (keys &env)) 275 | *lang* @(resolve lang) 276 | *clojure-dialect* (if (:ns &env) :cljs :clj)] 277 | (parse col))] 278 | `(~@f))) 279 | 280 | (defmacro %* 281 | "Transforms form and its subforms into clojure syntax without mixfix ops. 282 | First argument specifies language name." 283 | [lang & f] 284 | `(%1* ~lang ~@(propagate-% lang (vec f)))) 285 | 286 | (defn to-mixfix-1 287 | "Reverse of %. Takes a plain clojure form and transforms it to the one with 288 | mixifix operators." 289 | [col] (->> col (print-from-table (:write @*lang*)) (apply list))) 290 | 291 | (defn to-mixfix [col] (w/prewalk 292 | #(if (and (list? %) (> (count %) 1)) 293 | (to-mixfix-1 %) %) 294 | col)) 295 | 296 | 297 | (defmacro form [& args] `(~@args)) 298 | 299 | (op 1000 mixfix.clj.core/form [[assoc] [+]]) 300 | 301 | nil 302 | 303 | -------------------------------------------------------------------------------- /src/mixfix/clj/parser.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.parser 2 | "Parsing combinators for ambiguous grammars with left recursion. 3 | 4 | Based on Johnson's 'Memoization in Top-Down Parsing'" 5 | (:refer-clojure :exclude [list seq])) 6 | 7 | (def ^:dynamic *enableTrace* 8 | "turns on/off traces specified with `trace` combinator" 9 | false) 10 | 11 | (def zero 12 | "always fails" 13 | (fn [pos inp cont] ())) 14 | 15 | (defn- parser? [v] (fn? v)) 16 | 17 | (defn trace 18 | "Output debugging infomation during entering 19 | and exiting parser's function." 20 | [name this] {:pre [(parser? this)]} 21 | (if *enableTrace* 22 | (fn [pos inp cont] 23 | (let [tok (get inp pos)] 24 | (println "> " name pos tok) 25 | (this pos inp 26 | (fn [npos nval] 27 | (println "< " name pos tok nval) 28 | (cont npos nval))))) 29 | this)) 30 | 31 | (defn once 32 | "For ambiguous parser returns only its first alternative if there is any. 33 | Uses exceptions to avoid next alternatives calculation." 34 | [this] {:pre [(parser? this)]} 35 | (fn [p i c] 36 | (let [res (atom nil)] 37 | (try 38 | (this p i 39 | (fn [np v] 40 | (reset! res [np v]) 41 | (throw (ex-info "Exit" {:type :exit}) 42 | ))) 43 | (catch clojure.lang.ExceptionInfo e 44 | (when (-> e ex-data :type (= :exit)) 45 | (apply c @res))))))) 46 | 47 | (defn return 48 | "Returns parser which doesn't consume anything and 49 | always returns `val` (monadish return)." 50 | [val] (fn [pos inp cont] (cont pos val))) 51 | 52 | (defn guard 53 | "filters out values where `pred` returns false" 54 | [this pred] {:pre [(parser? this) (fn? pred)]} 55 | (fn [pos inp cont] 56 | (this pos inp 57 | (fn [npos val] 58 | (when (pred val) (cont npos val)))))) 59 | 60 | (defn any 61 | "Consumes single token and returns it." 62 | [pos inp cont] 63 | (when (< pos (count inp)) 64 | (cont (inc pos) (nth inp pos)))) 65 | 66 | (defn tok 67 | "If without arguments it returns parser consuming any token, 68 | if with a single argument it will consume only tokens equal to it." 69 | ([] any) 70 | ([t] (guard any (partial = t)))) 71 | 72 | (defn sym 73 | "parses clojure symbol token by its name (ignores namespace)" 74 | [t] 75 | (trace (format "name-%s" t) 76 | (guard any 77 | #(and (symbol? %) (= (name t) (name %)))))) 78 | 79 | (def pos 80 | "Returns current position." 81 | (fn [p i c] (c i p))) 82 | 83 | (def eof 84 | "Check it is end of file now." 85 | (fn [p i c] 86 | (when (= (count i) p) 87 | (c i p)))) 88 | 89 | (defn alt 90 | "Grammar's alternatives. They may be ambiguous." 91 | [& opts] {:pre [(every? parser? opts)]} 92 | (fn [pos inp cont] 93 | (doseq [x opts] 94 | (x pos inp cont)))) 95 | 96 | (defn seq 97 | "Sequence of parsers, returns list of their resulting values" 98 | ([] (return [])) 99 | ([col] {:pre [((some-fn parser? (partial every? parser?)) col)]} 100 | (if (coll? col) 101 | (if (empty? col) 102 | (return []) 103 | (let [[h & t] col 104 | ts (apply seq t)] ;TODO: maybe trampoline 105 | (fn [pos inp cont] 106 | (h pos inp 107 | (fn [hpos hval] 108 | (ts hpos inp 109 | (fn [tpos tval] 110 | (cont tpos (cons hval tval))))))))) 111 | (seq [col]))) 112 | ([v & other] 113 | (seq (cons v other)))) 114 | 115 | (defn join 116 | "Monadish join. Useful for adding context depedency, but very hard to use 117 | for ambigous grammars. So it is better to avoid it." 118 | [this] {:pre [(parser? this)]} 119 | (fn [pos inp cont] 120 | (this pos inp 121 | (fn [npos inner] 122 | (inner npos inp cont))))) 123 | 124 | (defn $ 125 | "Maps parser's values. With single argument it equals to `return`. With 2 and 126 | more arguments the first is a function to apply to parsers' result values 127 | and the rest are the parsers. Number of parsers arguments should be equal 128 | to function's arity." 129 | ([v] (return v)) 130 | ([f i] {:pre [(fn? f) (parser? i)]} 131 | (fn [pos inp cont] 132 | (i pos inp 133 | (fn [npos v] 134 | (cont npos (f v)))))) 135 | ([f i & others] {:pre [(fn? f) (parser? i) (every? parser? others)]} 136 | ($ (partial apply f) (seq (cons i others))))) 137 | 138 | (defmacro $-> 139 | "Maps parser's value through the forms using `->`." 140 | [this & forms] 141 | `($ (fn [k#] (-> k# ~@forms)) ~this)) 142 | 143 | (defmacro $->> 144 | "Maps parser's value through the forms using `->>`." 145 | [this & forms] 146 | `($ (fn [k#] (->> k# ~@forms)) ~this)) 147 | 148 | (defn >>= 149 | "Monadish bind. It is better to avoid it because it is quite hard to reason 150 | for ambiguous grammars." 151 | [arg fun] 152 | (join ($ fun arg))) 153 | 154 | (def ^:private memoId (atom 0)) 155 | (def ^:dynamic ^:private *memoTable*) 156 | 157 | (defn- getMemoTable [id] 158 | (let [mt @*memoTable*] 159 | (or (mt id) 160 | (let [r (atom {})] 161 | (reset! *memoTable* (assoc mt id r)) r)))) 162 | 163 | (defn memo 164 | "Memoises the parser." 165 | [this] {:pre [(parser? this)]} 166 | (let [id (swap! memoId inc)] 167 | (fn [pos inp cont] 168 | (let [table (getMemoTable id)] 169 | (if-let [[vals conts] (@table pos)] 170 | (do 171 | (swap! conts conj cont) 172 | (doseq [[npos nval] @vals] (cont npos nval))) 173 | (let [vals (atom #{}) 174 | conts (atom [cont])] 175 | (swap! table assoc pos [vals conts]) 176 | (this pos inp 177 | (fn [npos nval] 178 | (when-not (contains? @vals nval) 179 | (swap! vals conj [npos nval]) 180 | (doseq [i @conts] (i npos nval))))))))))) 181 | 182 | (defn run 183 | "Runs the parser for `input`. Returns vector of possible parser's values. 184 | It is only 1 value if the parser is non ambiguous." 185 | [this input] 186 | (when *enableTrace* 187 | (println "parse" input)) 188 | (let [res (transient [])] 189 | (binding [*memoTable* (atom {})] 190 | (this 0 (vec input) 191 | (fn [npos val] 192 | (when *enableTrace* 193 | (println "parse result" input val npos)) 194 | (conj! res val)))) 195 | (persistent! res))) 196 | 197 | (defn all 198 | "returns all possible result positions and values for `this` parser" 199 | [this] 200 | (fn [p i c] 201 | (let [res (transient [])] 202 | (this p i (fn [np v] (conj! res [np v]))) 203 | (persistent! res)))) 204 | 205 | (defn- deferRef [ref] 206 | (fn [pos inp cont] (@ref pos inp cont))) 207 | 208 | (defmacro defer 209 | "Defers parser creation for recursive grammar nodes." 210 | [opt] 211 | `(fn [pos# inp# cont#] 212 | (~opt pos# inp# cont#))) 213 | 214 | (defn fix 215 | "Helper combinator for recursive grammars creation. Calls f with an argument 216 | refereeing to parser node is to be return by the function and returns that 217 | parser." 218 | [f] {:pre (fn? f)} 219 | (let [r (atom nil) 220 | s (f (trace "rec" (memo (deferRef r))))] 221 | (reset! r s))) 222 | 223 | (def ^:private kwVal {}) 224 | 225 | (defn full 226 | [this] ($ first (seq this eof))) 227 | 228 | (defn many 229 | "applies the `this` parser non-deterministcaly [0, 1, ...] times 230 | returns collection of results" 231 | [this] {:pre [(parser? this)]} 232 | (fix #(alt (return []) ($ cons this %)))) 233 | 234 | (defn many! 235 | "eager determenistic version of many" 236 | [this] {:pre [(parser? this)]} 237 | (fix #(once (alt ($ cons this %) (return []))))) 238 | 239 | (defn run1 [parser input] 240 | (let [n (run parser input)] 241 | (cond 242 | (empty? n) (throw (IllegalArgumentException. (format "no parse for %s" input))) 243 | (= (count n) 1) (first n) 244 | :else (throw (IllegalArgumentException. 245 | (format "%s is ambiguous, options are: %s" input n)))))) 246 | 247 | (defn exp-table 248 | "Builds mixfix expressions parser." 249 | [table factor] {:pre [(map? table), (not (empty? table))]} 250 | (let [ 251 | st (into (sorted-map) table) 252 | m (into (sorted-map) (for [[i] table] [i (atom zero)])) 253 | top (->> m first val deferRef (trace "top") memo) 254 | res (full top) 255 | f (memo (trace "factor" factor)) 256 | byprec (fn [k] 257 | (let [v (first (filter #(>= (key %) k) m))] 258 | (if v (deferRef (val v)) f))) 259 | prim (fn [t] 260 | (if (map? t) 261 | (let [sub (byprec (:prec t))] 262 | (if (:cut t) (det sub) sub)) 263 | ($ (constantly kwVal) (sym t)))) 264 | layers (into (hash-map) 265 | (reductions 266 | (fn [[ai av] [ci cv]] [ci (alt av cv)]) 267 | [0 f] 268 | (for [[i v] (rseq st)] 269 | [i (apply alt 270 | (for [[pat fun] v] 271 | ($ 272 | (fn [v] 273 | (apply fun (filter 274 | #(not (identical? kwVal %)) v))) 275 | (seq (map prim pat)))))])))] 276 | (doseq [[k ref] m] 277 | (reset! ref (memo (trace (format "layer:%d" k) (layers k))))) 278 | res)) 279 | 280 | 281 | -------------------------------------------------------------------------------- /test/mixfix/clj/assoc_test.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.assoc_test 2 | (:require [clojure.test :refer :all] 3 | [mixfix.clj.core :refer :all])) 4 | 5 | (op 2000 oper1 [[+] $$ [assoc]]) 6 | (op 2000 oper2 [[assoc id 0] || [+]]) 7 | 8 | (defmacro check [c m] 9 | `(do 10 | (is (= (parse-all '(~@m)) '(~@c))) 11 | (is (= (to-mixfix '(~@c)) '(~@m))))) 12 | 13 | (deftest rassoc-operators [] 14 | (check (oper1 1 2) (1 $$ 2)) 15 | (check (oper1 1 2 3) (1 $$ 2 $$ 3)) 16 | (check (oper1 1 2 3 4) (1 $$ 2 $$ 3 $$ 4)) 17 | (check (oper1 (oper1 1 2) 3 4) ((1 $$ 2) $$ 3 $$ 4)) 18 | (check (oper1 (oper1 1 2 3) 4 5) ((1 $$ 2 $$ 3) $$ 4 $$ 5)) 19 | (check (oper1 1 (oper1 2 3) 4) (1 $$ (2 $$ 3) $$ 4)) 20 | (is (= (to-mixfix '(oper1 1 2 (oper1 3 4))) '(1 $$ 2 $$ 3 $$ 4))) 21 | (is (= (to-mixfix '(oper1 1 (oper1 2 (oper1 3 4)))) '(1 $$ 2 $$ 3 $$ 4))) 22 | (check (oper1 (oper1 (oper1 (oper1 1 2) 3) 4) 5) ((((1 $$ 2) $$ 3) $$ 4) $$ 5))) 23 | 24 | (deftest lassoc-operators [] 25 | (check (oper2 1) (0 || 1)) 26 | (check (oper2 1 0) (1 || 0)) 27 | (check (oper2 1 2) (1 || 2)) 28 | (check (oper2 1 2 3) (1 || 2 || 3)) 29 | (check (oper2 1 (oper2 2 3)) (1 || (2 || 3))) 30 | (check (oper2 1 (oper2 2 (oper2 3 4))) (1 || (2 || (3 || 4))))) 31 | 32 | (deftest space-operators [] 33 | (add-op 1000 'form [['assoc] ['+]]) 34 | (add-op 200 'if ['if ['+] 'then []]) 35 | (is (= (parse '(if = 2 2 then :t)) '(if (form = 2 2) :t))) 36 | (rm-op 'form) 37 | (is (= (parse '(if (= 2 2) then :t)) '(if (= 2 2) :t))) 38 | (add-op 1000 'list [['assoc] ['+]]) 39 | (is (= (parse '(1 2 3)) '(list 1 2 3))) 40 | (rm-op 'list)) 41 | -------------------------------------------------------------------------------- /test/mixfix/clj/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.core-test 2 | (:require [clojure.test :refer :all] 3 | [mixfix.clj.core :refer :all] 4 | [mixfix.clj.parser :as r])) 5 | 6 | (remove-op form) 7 | (remove-op +) 8 | (remove-op if) 9 | (op 400 + [[] + [+]]) 10 | (op 400 - [[] - [+]]) 11 | (op 500 * [[] * [+]]) 12 | (op 500 / [[] / [+]]) 13 | 14 | (declare-lang bools global) 15 | 16 | (op 200 or [[] or [+]]) 17 | (op bools 200 or [[] or [+]]) 18 | (op bools 300 and [[] and [+]]) 19 | (op bools 400 = [[] == []]) 20 | 21 | (op bools 100 if [if [+] then []]) 22 | (op bools 110 if [if [+] then [] else []]) 23 | 24 | (def z 4) 25 | 26 | (deftest simple-arith [] 27 | (is (= (% 3 - 2 - 1) 0)) 28 | (is (= (% 16 / 4 / 2 / 2) 1)) 29 | (is (= (% 1 + 2 * 2 - 2 * 3))) 30 | (is (= (% (2 + 2) * 2) 8)) 31 | (let [x 2 y 3] 32 | (is (= (% x + y * z) 14))) 33 | (is (= (% (+ 2 2) + 3) 7)) 34 | (is (= (let [x 2] (% let [a (2 + 3) b (- a x)] (a - b))) 2))) 35 | 36 | (deftest simple-bools [] 37 | (%* bools do 38 | (is (= (true or false)) true) 39 | (is (= (2 + 3) 5)) 40 | (is (= (if true then 2 else 3) 2)) 41 | (is (= (if 2 == 3 then 2 else 3) 3)) 42 | (is (= (if 2 == 2 then if 2 == 3 or 3 == 4 then 1 else 2 else 3) 2)))) 43 | 44 | (def ^:dynamic *cur-lang* global) 45 | 46 | (defmacro check [c m] 47 | `(do 48 | (is (= (parse-all '(~@m)) '(~@c))) 49 | (is (= (to-mixfix '(~@c)) '(~@m))))) 50 | 51 | (deftest arith-print [] 52 | (rm-op '+) 53 | (add-op 400 '+ [[] '+ ['+]]) 54 | (check (+ 2 3) (2 + 3)) 55 | (check (quot 2 3) (quot 2 3)) 56 | (check (+ (+ 2 3) 4) (2 + 3 + 4)) 57 | (check (+ 2 (+ 3 4)) (2 + (3 + 4))) 58 | (check (+ (* 2 3) 4) (2 * 3 + 4)) 59 | (check (+ 2 (* 3 4)) (2 + 3 * 4)) 60 | (binding [*locals* #{'x 'y}] 61 | (check (+ (+ (+ x y) (rand)) 2) (x + y + (rand) + 2))) 62 | (is (thrown? IllegalArgumentException (parse '(x + 1))))) 63 | 64 | (deftest bool-print [] 65 | (binding [*lang* bools] 66 | (check (or true false) (true or false)) 67 | (check (and 1 (or 2 3)) (1 and (2 or 3))) 68 | (check (or 1 (and 2 3)) (1 or 2 and 3)) 69 | (check (if (= 2 3) (if (= 4 3) (if (= 5 6) 11 10) 20)) 70 | (if 2 == 3 then if 4 == 3 then if 5 == 6 then 11 else 10 else 20)) 71 | (is (thrown? IllegalArgumentException 72 | (binding [*lang* bools] (parse '(if 2 = 3 then 2 else 3))))))) 73 | 74 | (deftest space-operator [] 75 | (check (+ 2 2) (2 + 2)) 76 | (check (2 2) (2 2)) 77 | (check (2 2 2) (2 2 2)) 78 | (check ((2 2) 2) ((2 2) 2))) 79 | -------------------------------------------------------------------------------- /test/mixfix/clj/parser_test.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.parser-test 2 | (:require [mixfix.clj.parser :refer :all] 3 | [clojure.test :refer :all]) 4 | (:refer-clojure :exclude [list seq])) 5 | 6 | (def N (alt (tok :student) (tok :professor))) 7 | (def Det (alt (tok :every) (tok :no))) 8 | (def V (alt (tok :likes) (tok :knows))) 9 | (def PN (alt (tok :Kim) (tok :Sandy))) 10 | (def NP (alt PN (seq Det N))) 11 | (declare VP) 12 | (def S (defer (seq NP VP))) 13 | (def VP (alt (seq V NP) (seq V S))) 14 | 15 | 16 | (def NP2 (memo (defer (alt PN (seq NP2 N) (seq Det N))))) 17 | (declare VP2) 18 | (def S2 (defer (seq NP2 VP2))) 19 | (def VP2 (alt (seq V NP2) (seq V S2))) 20 | 21 | (deftest test-parser-simple [] 22 | (is (= (run S [:Kim :knows :every :student :likes :Sandy]) 23 | ['(:Kim (:knows (:every :student))) 24 | '(:Kim (:knows ((:every :student) (:likes :Sandy))))] 25 | )) 26 | (is (= (run S2 [:Kim :professor :knows :every :student :likes :Sandy]) 27 | ['((:Kim :professor) (:knows (:every :student))) 28 | '((:Kim :professor) (:knows ((:every :student) (:likes :Sandy))))] 29 | )) 30 | (is (= (run S2 [:Kim :professor :knows :every :student]) 31 | ['((:Kim :professor) (:knows (:every :student)))])) 32 | (is (= (run1 ($-> (return 100) inc (- 100)) []) 1)) 33 | (is (= (run1 ($->> (return 100) inc (- 100)) []) -1)) 34 | (is (= (run1 (>>= (return 1) #(return (inc %))) [])) 2) 35 | (is (= (run (>>= (return 1) (constantly zero)) []) [])) 36 | (is (= (run1 (once (alt (return 1) 37 | ($ #(throw (Exception. (str %))) (return 2)))) []) 1)) 38 | (is (= (run1 (many! (tok 1)) [1 1 1 1]) [1 1 1 1])) 39 | (is (= (run (many (tok 1)) [1 1 1 1]) [[] [1] [1 1] [1 1 1] [1 1 1 1]]))) 40 | -------------------------------------------------------------------------------- /test/mixfix/clj/redirs_all_test.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.redirs-all-test 2 | (:refer-clojure :exclude [defn def]) 3 | (:require [clojure.test :refer :all] 4 | [mixfix.clj :refer :all])) 5 | 6 | (op 400 + [[assoc] + [+]]) 7 | 8 | (defn t1 [x y z] (x + y + z)) 9 | 10 | (deftest simple [] 11 | (is (= (% 2 + (2 + 2)) 6)) 12 | (is (= (t1 2 3 4) 9))) 13 | -------------------------------------------------------------------------------- /test/mixfix/clj/redirs_test.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.redirs_test 2 | (:require [clojure.test :refer :all] 3 | [mixfix.clj :as r] 4 | )) 5 | 6 | (r/op 400 + [[assoc id 0] + [+]]) 7 | 8 | (r/defn t1 [x y z] (x + y + z)) 9 | 10 | (deftest simple [] 11 | (is (= (r/% 2 + (2 + 2)) 6)) 12 | (is (= (t1 2 3 4) 9))) 13 | 14 | (macroexpand '(r/% 0 + 1)) 15 | -------------------------------------------------------------------------------- /test/mixfix/clj/sql_test.clj: -------------------------------------------------------------------------------- 1 | (ns mixfix.clj.sql-test 2 | (:refer-clojure :exclude [*]) 3 | (:require [clojure.test :refer :all] 4 | [mixfix.clj.core :as r] 5 | )) 6 | 7 | (r/declare-lang sql) 8 | (r/op sql 100 select [select [+] from [+] where [+] group by [+]]) 9 | (r/op sql 100 select [select [+] from [+] where [+]]) 10 | (r/op sql 100 select [select [+] from [+]]) 11 | (r/op sql 200 list [[assoc] [+]]) 12 | (r/op sql 150 = [[+] = [+]]) 13 | (r/op sql 150 < [[+] < [+]]) 14 | 15 | (defmacro check [c a] 16 | `(do 17 | (is (= '(~@a) (r/parse '(~@c)))) 18 | (is (= '(~@c) (r/to-mixfix '(~@a)))))) 19 | 20 | (deftest test-sql [] 21 | (binding [r/*lang* sql 22 | r/*locals* #{'* 'col1 'col2 'table1 'table2}] 23 | (check (select * from table1) 24 | (select * table1)) 25 | (check (select col1, col2 from table1, table2 where col1 = col2) 26 | (select (list col1 col2) (list table1 table2) (= col1 col2))) 27 | (check (select * from table1, table2 where col1 < col2 group by col1, col2) 28 | (select * (list table1 table2) (< col1 col2) (list col1 col2))))) 29 | --------------------------------------------------------------------------------