├── LICENSE ├── Makefile ├── README.md ├── doc ├── .gitignore └── overview.edoc ├── ebin ├── .gitignore └── merl.app ├── examples ├── Makefile ├── basic.erl ├── basic_test.erl ├── basicc.erl ├── lisp.erl ├── lisp_test.erl ├── lispc.erl └── merl_build.erl ├── include └── merl.hrl ├── priv └── .gitignore └── src ├── merl.erl ├── merl_tests.erl └── merl_transform.erl /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # simple Makefile 2 | VSN=0.9.0 3 | ERLC_FLAGS= 4 | SOURCES=$(wildcard src/*.erl) 5 | HEADERS=$(wildcard include/*.hrl) 6 | OBJECTS=$(SOURCES:src/%.erl=ebin/%.beam) 7 | DOC_OPTS={def,{version,\"$(VSN)\"}} 8 | 9 | .PHONY: all 10 | all: $(OBJECTS) 11 | 12 | ebin/%.beam: src/%.erl $(HEADERS) Makefile 13 | erlc -pz ./priv -pa ./ebin $(ERLC_FLAGS) -o ebin/ $< 14 | 15 | # additional dependencies due to the parse transform 16 | ebin/merl_tests.beam ebin/merl_build.beam: \ 17 | ebin/merl_transform.beam ebin/merl.beam 18 | 19 | # special rules and dependencies to apply the transform to itself 20 | ebin/merl_transform.beam: ebin/merl.beam priv/merl_transform.beam 21 | priv/merl_transform.beam: src/merl_transform.erl $(HEADERS) Makefile 22 | erlc -DMERL_NO_TRANSFORM $(ERLC_FLAGS) -o priv/ $< 23 | 24 | .PHONY: clean 25 | clean: 26 | -rm -f priv/merl_transform.beam 27 | -rm -f $(OBJECTS) 28 | (cd examples && make clean) 29 | 30 | .PHONY: test 31 | test: 32 | erl -noshell -pa ebin \ 33 | -eval 'eunit:test("ebin",[])' \ 34 | -s init stop 35 | 36 | .PHONY: release 37 | release: clean 38 | $(MAKE) ERLC_FLAGS="$(ERLC_FLAGS) -DNOTEST" 39 | 40 | .PHONY: docs 41 | docs: 42 | erl -pa ./ebin -noshell -eval "edoc:application(merl, \".\", [$(DOC_OPTS)])" -s init stop 43 | 44 | .PHONY: examples 45 | examples: 46 | (cd examples && make) 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Merl - Metaprograming in Erlang 2 | =============================== 3 | 4 | *NOTE: as of Erlang/OTP 18.0, Merl is included in the syntax_tools application! This repository remains here for use by those unable to upgrade to version 18.0 or later.* 5 | 6 | Merl is a more user friendly interface to the `erl_syntax` module in the 7 | standard library `syntax_tools` application, making it easy both to build 8 | new ASTs (abstract syntax trees) from scratch and to match and decompose 9 | existing ASTs. 10 | 11 | To enable the full power of Merl, your module needs to include the Merl 12 | header file: 13 | 14 | -include_lib("merl/include/merl.hrl"). 15 | 16 | Then, you can use `?Q(Text)` macros in your code to create ASTs or match 17 | on existing ASTs. For example: 18 | 19 | Tuple = ?Q("{foo, 42}"), 20 | ?Q("{foo, _@Number}") = Tuple, 21 | Call = ?Q("foo:bar(_@Number)") 22 | 23 | Calling `merl:print(Call)` will then print the following code: 24 | 25 | foo:bar(42) 26 | 27 | The `?Q` macros turn the quoted code fragments into ASTs, and lifts 28 | metavariables such as `_@Tuple` and `_@Number` to the level of your Erlang 29 | code, so you can use the corresponding Erlang variables `Tuple` and `Number` 30 | directly. This is the most straightforward way to use Merl, and in many 31 | cases it's all you need. 32 | 33 | You can even write case switches using `?Q` macros as patterns. For example: 34 | 35 | case AST of 36 | ?Q("{foo, _@Foo}") -> handle(Foo); 37 | ?Q("{bar, _@Bar}") when erl_syntax:is_integer(Bar) -> handle(Bar); 38 | _ -> handle_default() 39 | end 40 | 41 | For the full documentation, run `make docs` and open `doc/index.html` in a 42 | browser. For a quick look at the user guide without generating the HTML 43 | docs, see the file `doc/overview.edoc`. 44 | -------------------------------------------------------------------------------- /doc/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | stylesheet.css 3 | erlang.png 4 | edoc-info 5 | -------------------------------------------------------------------------------- /doc/overview.edoc: -------------------------------------------------------------------------------- 1 | -*- html -*- 2 | 3 | Merl overview page 4 | 5 | Note: EDoc uses @@ and @} as escape sequences, so in the below text, `@@' 6 | must be written `@@@@' and `@}' must be written `@@}' 7 | 8 | @author Richard Carlsson 9 | @copyright 2010-2014 Richard Carlsson 10 | @title Merl - Metaprograming in Erlang 11 | 12 | @doc Merl is a more user friendly interface to the `erl_syntax' module in 13 | the `syntax_tools' application, making it easy both to build new ASTs 14 | (abstract syntax trees) from scratch and to match and decompose existing 15 | ASTs. For details that are outside the scope of Merl itself, please see the 16 | documentation of `erl_syntax'. 17 | 18 | == Quick start == 19 | 20 | To enable the full power of Merl, your module needs to include the Merl 21 | header file: 22 | ```-include_lib("merl/include/merl.hrl").''' 23 | 24 | Then, you can use the `?Q(Text)' macros in your code to create ASTs or match 25 | on existing ASTs. For example: 26 | ```Tuple = ?Q("{foo, 42}"), 27 | ?Q("{foo, _@Number}") = Tuple, 28 | Call = ?Q("foo:bar(_@Number)")''' 29 | 30 | Calling `merl:print(Call)' will then print the following code: 31 | ```foo:bar(42)''' 32 | 33 | The `?Q' macros turn the quoted code fragments into ASTs, and lifts 34 | metavariables such as `_@Tuple' and `_@Number' to the level of your Erlang 35 | code, so you can use the corresponding Erlang variables `Tuple' and `Number' 36 | directly. This is the most straightforward way to use Merl, and in many 37 | cases it's all you need. 38 | 39 | You can even write case switches using `?Q' macros as patterns. For example: 40 | ```case AST of 41 | ?Q("{foo, _@Foo}") -> handle(Foo); 42 | ?Q("{bar, _@Bar}") when erl_syntax:is_integer(Bar) -> handle(Bar); 43 | _ -> handle_default() 44 | end''' 45 | 46 | These case switches only allow `?Q(...)' or `_' as clause patterns, and the 47 | guards may contain any expressions, not just Erlang guard expressions. 48 | 49 | If the macro `MERL_NO_TRANSFORM' is defined before the `merl.hrl' header 50 | file is included, the parse transform used by Merl will be disabled, and in 51 | that case, the match expressions `?Q(...) = ...', case switches using 52 | `?Q(...)' patterns, and automatic metavariables like `_@Tuple' cannot be 53 | used in your code, but the Merl macros and functions still work. To do 54 | metavariable substitution, you need to use the `?Q(Text, Map)' macro, e.g.: 55 | ```Tuple = ?Q("{foo, _@bar, _@baz}", [{bar, Bar}, {baz,Baz}])''' 56 | 57 | The text given to a `?Q(Text)' macro can be either a single string, or a 58 | list of strings. The latter is useful when you need to split a long 59 | expression over multiple lines, e.g.: 60 | ```?Q(["case _@Expr of", 61 | " {foo, X} -> f(X);", 62 | " {bar, X} -> g(X)", 63 | " _ -> h(X)" 64 | "end"])''' 65 | If there is a syntax error somewhere in the text (like the missing semicolon 66 | in the second clause above) this allows Merl to generate an error message 67 | pointing to the exact line in your source code. (Just remember to 68 | comma-separate the strings in the list, otherwise Erlang will concatenate 69 | the string fragments as if they were a single string.) 70 | 71 | == Metavariable syntax == 72 | 73 | There are several ways to write a metavariable in your quoted code: 74 | 80 | Following the prefix, one or more `_' or `0' characters may be used to 81 | indicate "lifting" of the variable one or more levels, and after that, a `@' 82 | or `9' character indicates a glob metavariable (matching zero or more 83 | elements in a sequence) rather than a normal metavariable. For example: 84 | 92 | (Note that the last character in the name is never considered to be a lift 93 | or glob marker, hence, `_@__' and `90900' are only lifted one level, not 94 | two. Also note that globs only matter for matching; when doing 95 | substitutions, a non-glob variable can be used to inject a sequence of 96 | elements, and vice versa.) 97 | 98 | If the name after the prefix and any lift and glob markers is `_' or `0', 99 | the variable is treated as an anonymous catch-all pattern in matches. For 100 | example, `_@_', `_@@@@_', `_@__', or even `_@__@_'. 101 | 102 | Finally, if the name without any prefixes or lift/glob markers begins with 103 | an uppercase character, as in `_@Foo' or `_@_@Foo', it will become a 104 | variable on the Erlang level, and can be used to easily deconstruct and 105 | construct syntax trees: 106 | ```case Input of 107 | ?Q("{foo, _@Number}") -> ?Q("foo:bar(_@Number)"); 108 | ...''' 109 | We refer to these as "automatic metavariables". If in addition the name ends 110 | with `@', as in `_@Foo@', the value of the variable as an Erlang term will 111 | be automatically converted to the corresponding abstract syntax tree when 112 | used to construct a larger tree. For example, in: 113 | ```Bar = {bar, 42}, 114 | Foo = ?Q("{foo, _@Bar@@}")''' 115 | (where Bar is just some term, not a syntax tree) the result `Foo' will be a 116 | syntax tree representing `{foo, {bar, 42}}'. This avoids the need for 117 | temporary variables in order to inject data, as in 118 | ```TmpBar = erl_syntax:abstract(Bar), 119 | Foo = ?Q("{foo, _@TmpBar}")''' 120 | 121 | If the context requires an integer rather than a variable, an atom, or a 122 | string, you cannot use the uppercase convention to mark an automatic 123 | metavariable. Instead, if the integer (without the `909'-prefix and 124 | lift/glob markers) ends in a `9', the integer will become an Erlang-level 125 | variable prefixed with `Q', and if it ends with `99' it will also be 126 | automatically abstracted. For example, the following will increment the 127 | arity of the exported function f: 128 | ```case Form of 129 | ?Q("-export([f/90919]).") -> 130 | Q2 = erl_syntax:concrete(Q1) + 1, 131 | ?Q("-export([f/909299])."); 132 | ...''' 133 | 134 | 135 | == When to use the various forms of metavariables == 136 | 137 | Merl can only parse a fragment of text if it follows the basic syntactical 138 | rules of Erlang. In most places, a normal Erlang variable can be used as 139 | metavariable, for example: 140 | ```?Q("f(_@Arg)") = Expr''' 141 | but if you want to match on something like the name of a function, you have 142 | to use an atom as metavariable: 143 | ```?Q("'@Name'() -> _@@@@_." = Function''' 144 | (note the anonymous glob variable `_@@@@_' to ignore the function body). 145 | 146 | In some contexts, only a string or an integer is allowed. For example, the 147 | directive `-file(Name, Line)' requires that `Name' is a string literal and 148 | `Line' an integer literal: 149 | 150 | ```?Q("-file(\"'@File\", 9090).") = ?Q("-file(\"foo.erl\", 42).")).''' 151 | This will extract the string literal `"foo.erl"' into the variable `Foo'. 152 | Note the use of the anonymous variable `9090' to ignore the line number. To 153 | match and also bind a metavariable that must be an integer literal, we can 154 | use the convention of ending the integer with a 9, turning it into a 155 | Q-prefixed variable on the Erlang level (see the previous section). 156 | 157 | === Globs === 158 | 159 | Whenever you want to match out a number of elements in a sequence (zero or 160 | more) rather than a fixed set of elements, you need to use a glob. For 161 | example: 162 | ```?Q("{_@@@@Elements}") = ?Q({a, b, c})''' 163 | will bind Elements to the list of individual syntax trees representing the 164 | atoms `a', `b', and `c'. This can also be used with static prefix and suffix 165 | elements in the sequence. For example: 166 | ```?Q("{a, b, _@@@@Elements}") = ?Q({a, b, c, d})''' 167 | will bind Elements to the list of the `c' and `d' subtrees, and 168 | ```?Q("{_@@@@Elements, c, d}") = ?Q({a, b, c, d})''' 169 | will bind Elements to the list of the `a' and `b' subtrees. You can even use 170 | plain metavariables in the prefix or suffix: 171 | ```?Q("{_@First, _@@@@Rest}") = ?Q({a, b, c})''' 172 | or 173 | ```?Q("{_@@@@_, _@Last}") = ?Q({a, b, c})''' 174 | (ignoring all but the last element). You cannot however have two globs as 175 | part of the same sequence. 176 | 177 | === Lifted metavariables === 178 | 179 | In some cases, the Erlang syntax rules make it impossible to place a 180 | metavariable directly where you would like it. For example, you cannot 181 | write: 182 | ```?Q("-export([_@@@@Name]).")''' 183 | to match out all name/arity pairs in the export list, or to insert a list of 184 | exports in a declaration, because the Erlang parser only allows elements on 185 | the form `A/I' (where `A' is an atom and `I' an integer) in the export list. 186 | A variable like the above is not allowed, but neither is a single atom or 187 | integer, so `` '@@@@Name' '' or `909919' wouldn't work either. 188 | 189 | What you have to do in such cases is to write your metavariable in a 190 | syntactically valid position, and use lifting markers to denote where it 191 | should really apply, as in: 192 | ```?Q("-export(['@@_@@Name'/0]).")''' 193 | This causes the variable to be lifted (after parsing) to the next higher 194 | level in the syntax tree, replacing that entire subtree. In this case, the 195 | `` '@@_@@Name'/0 '' will be replaced with `` '@@@@Name' '', and the ``/0'' 196 | part was just used as dummy notation and will be discarded. 197 | 198 | You may even need to apply lifting more than once. To match the entire 199 | export list as a single syntax tree, you can write: 200 | ```?Q("-export(['@@__Name'/0]).")''' 201 | using two underscores, but with no glob marker this time. This will make the 202 | entire ``['@@__Name'/0]'' part be replaced with `` '@@Name' ''. 203 | 204 | Sometimes, the tree structure of a code fragment isn't very obvious, and 205 | parts of the structure may be invisible when printed as source code. For 206 | instance, a simple function definition like the following: 207 | ```zero() -> 0.''' 208 | consists of the name (the atom `zero'), and a list of clauses containing the 209 | single clause `() -> 0'. The clause consists of an argument list (empty), a 210 | guard (empty), and a body (which is always a list of expressions) containing 211 | the single expression `0'. This means that to match out the name and the 212 | list of clauses of any function, you'll need to use a pattern like 213 | `?Q("'@Name'() -> _@_@Body.")', using a dummy clause whose body is a glob 214 | lifted one level. 215 | 216 | To visualize the structure of a syntax tree, you can use the function 217 | `merl:show(T)', which prints a summary. For example, entering 218 | ```merl:show(merl:quote("inc(X, Y) when Y > 0 -> X + Y."))''' 219 | in the Erlang shell will print the following (where the `+' signs separate 220 | groups of subtrees on the same level): 221 | ```function: inc(X, Y) when ... -> X + Y. 222 | atom: inc 223 | + 224 | clause: (X, Y) when ... -> X + Y 225 | variable: X 226 | variable: Y 227 | + 228 | disjunction: Y > 0 229 | conjunction: Y > 0 230 | infix_expr: Y > 0 231 | variable: Y 232 | + 233 | operator: > 234 | + 235 | integer: 0 236 | + 237 | infix_expr: X + Y 238 | variable: X 239 | + 240 | operator: + 241 | + 242 | variable: Y''' 243 | 244 | This shows another important non-obvious case: a clause guard, even if it's 245 | as simple as `Y > 0', always consists of a single disjunction of one or more 246 | conjunctions of tests, much like a tuple of tuples. Thus: 247 | 263 | 264 | Thus, the following pattern matches all possible clauses: 265 | ```"(_@@Args) when _@__@Guard -> _@@Body"''' 266 | -------------------------------------------------------------------------------- /ebin/.gitignore: -------------------------------------------------------------------------------- 1 | *.beam 2 | -------------------------------------------------------------------------------- /ebin/merl.app: -------------------------------------------------------------------------------- 1 | %% -*- mode: erlang -*- 2 | {application,merl, 3 | [{description,"Metaprogramming in Erlang"}, 4 | {vsn,"0.9.0"}, 5 | {modules, [merl, merl_transform, merl_tests]}, 6 | {applications, [kernel, stdlib, compiler, syntax_tools]}, 7 | {registered,[]} 8 | ]}. 9 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | ERLC_FLAGS=+debug_info 2 | SOURCES=merl_build.erl lisp.erl lispc.erl basic.erl basicc.erl 3 | INCLUDES=../include 4 | HEADERS=$(INCLUDES)/merl.hrl 5 | OBJECTS=$(SOURCES:%.erl=%.beam) 6 | 7 | all: $(OBJECTS) test 8 | 9 | %.beam: %.erl $(HEADERS) Makefile 10 | erlc -pa ../ebin $(ERLC_FLAGS) -o ./ $< 11 | 12 | # additional dependencies due to the parse transform 13 | lispc.beam basicc.beam: ../ebin/merl_transform.beam ../ebin/merl.beam 14 | 15 | clean: 16 | -rm -f $(OBJECTS) 17 | 18 | test: 19 | erl -noshell -pa ../ebin \ 20 | -eval 'eunit:test([lisp, lispc, basic, basicc],[])' \ 21 | -s init stop 22 | -------------------------------------------------------------------------------- /examples/basic.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Trivial Basic interpreter in Erlang 15 | 16 | -module(basic). 17 | 18 | -export([run/2]). 19 | 20 | -include_lib("eunit/include/eunit.hrl"). 21 | 22 | -define(INTERPRETED, true). 23 | -include("basic_test.erl"). 24 | 25 | run(N, Prog) -> 26 | ets:new(var, [private, named_table]), 27 | ets:new(line, [private, named_table, ordered_set]), 28 | lists:foreach(fun (T) -> ets:insert(line, T) end, Prog), 29 | goto(N). 30 | 31 | stop(N) -> 32 | ets:delete(var), 33 | ets:delete(line), 34 | N. 35 | 36 | goto('$end_of_table') -> stop(0); 37 | goto(L) -> 38 | L1 = ets:next(line, L), 39 | %% user-supplied line numbers might not exist 40 | case ets:lookup(line, L) of 41 | [{_, X}] -> 42 | stmt(X, L1); 43 | _ -> 44 | goto(L1) 45 | end. 46 | 47 | stmt({print, S, As}, L) -> io:format(S, [expr(A) || A <- As]), goto(L); 48 | stmt({set, V, X}, L) -> ets:insert(var, {V, expr(X)}), goto(L); 49 | stmt({goto, X}, _L) -> goto(expr(X)); 50 | stmt({stop, X}, _L) -> stop(expr(X)); 51 | stmt({iff, X, A, B}, _L) -> 52 | case expr(X) of 53 | 0 -> goto(B); 54 | _ -> goto(A) 55 | end. 56 | 57 | expr(X) when is_number(X) ; is_list(X) -> 58 | X; 59 | expr(X) when is_atom(X) -> 60 | case ets:lookup(var, X) of 61 | [] -> 0; 62 | [{_,V}] -> V 63 | end; 64 | expr({plus, X, Y}) -> 65 | expr(X) + expr(Y); 66 | expr({equal, X, Y}) -> 67 | bool(expr(X) == expr(Y)); 68 | expr({gt, X, Y}) -> 69 | bool(expr(X) > expr(Y)); 70 | expr({knot, X}) -> 71 | case expr(X) of 72 | 0 -> 1; 73 | _ -> 0 74 | end. 75 | 76 | bool(true) -> 1; 77 | bool(false) -> 0. 78 | -------------------------------------------------------------------------------- /examples/basic_test.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Tests. For including in another module. 15 | 16 | %-module(basic_test). 17 | %-import(basic, run/1) 18 | 19 | -export([basic_fib/1]). 20 | 21 | -include_lib("eunit/include/eunit.hrl"). 22 | 23 | basics_test_() -> 24 | [?_assertEqual(42, run(1,[{1,{stop, 42}}])), 25 | ?_assertEqual("hello", run(1,[{1,{stop,"hello"}}])), 26 | ?_assertEqual(0, run(1,[{1,{print, "hello ~w", [42]}}])), 27 | ?_assertEqual(5, run(1,[{1,{stop, {plus, 2, 3}}}])), 28 | ?_assertEqual(5, run(1,[{1,{stop,{plus, 8, -3}}}])), 29 | ?_assertEqual(0, run(1,[{1,{stop,{equal, 0, 1}}}])), 30 | ?_assertEqual(1, run(1,[{1,{stop,{equal, 1, 1}}}])), 31 | ?_assertEqual(0, run(1,[{1,{stop,{gt, 0, 1}}}])), 32 | ?_assertEqual(0, run(1,[{1,{stop,{gt, 1, 1}}}])), 33 | ?_assertEqual(1, run(1,[{1,{stop,{gt, 2, 1}}}])), 34 | ?_assertEqual(0, run(1,[{1,{stop,{knot, 42}}}])), 35 | ?_assertEqual(1, run(1,[{1,{stop,{knot, 0}}}])), 36 | ?_assertEqual(42, run(1,[{1,{set, x, 42}}, {2,{stop,x}}])), 37 | ?_assertEqual(17, run(1,[{1,{iff, 1, 2, 3}}, 38 | {2,{stop, 17}}, 39 | {3,{stop, 42}}])), 40 | ?_assertEqual(42, run(1,[{1,{iff, 0, 2, 3}}, 41 | {2,{stop, 17}}, 42 | {3,{stop, 42}}])), 43 | ?_assertEqual(17, run(1,[{1,{iff, 1, 2, 3}}, 44 | {2,{stop, 17}}, 45 | {3,{stop, -1}}])), 46 | ?_assertEqual(42, run(1,[{1,{iff, 0, 2, 3}}, 47 | {2,{stop, -1}}, 48 | {3,{stop, 42}}])) 49 | 50 | 51 | ]. 52 | 53 | 54 | fib_test_() -> 55 | [?_assertEqual(fib(N), basic_fib(N)) || N <- lists:seq(1,15) 56 | ]. 57 | 58 | 59 | fib(N) when N > 1 -> 60 | fib(N-1) + fib(N-2); 61 | fib(_) -> 62 | 1. 63 | 64 | basic_fib(N) -> 65 | run(1, 66 | [{1,{set,x,0}}, 67 | {2,{set,a,1}}, 68 | {3,{set,b,0}}, 69 | {10,{iff, {equal, x, N}, 20, 30}}, 70 | {20,{stop,a}}, 71 | {30,{print,"~w, ~w, ~w\n",[x,a,b]}}, 72 | {31,{set,t,a}}, 73 | {32,{set,a,{plus,a,b}}}, 74 | {33,{set,b,t}}, 75 | {34,{set,x,{plus,x,1}}}, 76 | {40,{goto,10}} 77 | ]). 78 | -------------------------------------------------------------------------------- /examples/basicc.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Basic compiler in Erlang. 15 | 16 | -module(basicc). 17 | 18 | -export([run/2, make_lines/1, bool/1]). 19 | 20 | -include_lib("eunit/include/eunit.hrl"). 21 | 22 | -define(INTERPRETED, true). 23 | -include("basic_test.erl"). 24 | 25 | -include("../include/merl.hrl"). 26 | 27 | run(N, Prog) -> 28 | compile(Prog, tmp), 29 | tmp:run(N, Prog). 30 | 31 | make_lines(Prog) -> 32 | ets:new(line, [private, named_table, ordered_set]), 33 | lists:foreach(fun ({L,_}) -> ets:insert(line, {L,label(L)}) end, Prog). 34 | 35 | compile(Prog, ModName) -> 36 | make_lines(Prog), 37 | Fs0 = lists:map(fun ({L, X}) -> 38 | {true, label(L), 39 | case stmt(X) of 40 | {Stmt, false} -> 41 | [?Q("() -> _@Stmt")]; 42 | {Stmt, true} -> 43 | Next = case ets:next(line, L) of 44 | '$end_of_table' -> 45 | ?Q("stop(0)"); 46 | L1 -> 47 | Label = label(L1), 48 | ?Q("_@Label@()") 49 | end, 50 | [?Q("() -> _@Stmt, _@Next")] 51 | end} 52 | end, Prog), 53 | ets:delete(line), 54 | Run = ?Q(["(N, Prog) ->", 55 | " ets:new(var, [private, named_table]),", 56 | " basicc:make_lines(Prog),", 57 | " goto(N)" 58 | ]), 59 | Stop = ?Q(["(R) ->", 60 | " ets:delete(var),", 61 | " ets:delete(line),", 62 | " R" 63 | ]), 64 | Goto = ?Q(["(L) ->", 65 | " case ets:lookup(line, L) of", 66 | " [{_, X}] -> apply(tmp, X, []);", 67 | " _ ->", 68 | " case ets:next(line, L) of", 69 | " '$end_of_table' -> stop(0);", 70 | " L1 -> goto(L1)", 71 | " end", 72 | " end"]), 73 | Fs = [{true, run, [Run]}, 74 | {false, stop, [Stop]}, 75 | {true, goto, [Goto]} 76 | | Fs0], 77 | Forms = merl_build:module_forms( 78 | lists:foldl(fun ({X, Name, Cs}, S) -> 79 | merl_build:add_function(X, Name, Cs, S) 80 | end, 81 | merl_build:init_module(ModName), 82 | Fs)), 83 | %% %% Write source to file for debugging 84 | %% file:write_file(lists:concat([ModName, "_gen.erl"]), 85 | %% erl_prettypr:format(erl_syntax:form_list(Forms), 86 | %% [{paper,160},{ribbon,80}])), 87 | merl:compile_and_load(Forms, [verbose]). 88 | 89 | label(L) -> 90 | list_to_atom("label_" ++ integer_to_list(L)). 91 | 92 | stmt({print, S, As}) -> 93 | Exprs = [expr(A) || A <- As], 94 | {[?Q(["io:format(_@S@, [_@Exprs])"])], true}; 95 | stmt({set, V, X}) -> 96 | Expr = expr(X), 97 | {[?Q(["ets:insert(var, {_@V@, _@Expr})"])], true}; 98 | stmt({goto, X}) -> 99 | {[jump(X)], false}; 100 | stmt({stop, X}) -> 101 | Expr = expr(X), 102 | {[?Q(["stop(_@Expr)"])], false}; 103 | stmt({iff, X, A, B}) -> 104 | Cond = expr(X), 105 | True = jump(A), 106 | False = jump(B), 107 | {?Q(["case _@Cond of", 108 | " 0 -> _@False;", 109 | " _ -> _@True", 110 | "end"]), 111 | false}. 112 | 113 | jump(X) -> 114 | case ets:lookup(line, X) of 115 | [{_, F}] -> 116 | ?Q(["_@F@()"]); 117 | true -> 118 | Expr = expr(X), 119 | [?Q(["goto(_@Expr)"])] 120 | end. 121 | 122 | expr(X) when is_number(X) ; is_list(X) -> 123 | ?Q("_@X@"); 124 | expr(X) when is_atom(X) -> 125 | ?Q(["case ets:lookup(var, _@X@) of", 126 | " [] -> 0;", 127 | " [{_,V}] -> V", 128 | "end"]); 129 | expr({plus, X, Y}) -> 130 | ExprX = expr(X), 131 | ExprY = expr(Y), 132 | ?Q("_@ExprX + _@ExprY"); 133 | expr({equal, X, Y}) -> 134 | ExprX = expr(X), 135 | ExprY = expr(Y), 136 | ?Q("basicc:bool(_@ExprX == _@ExprY)"); 137 | expr({gt, X, Y}) -> 138 | ExprX = expr(X), 139 | ExprY = expr(Y), 140 | ?Q("basicc:bool(_@ExprX > _@ExprY)"); 141 | expr({knot, X}) -> 142 | Expr = expr(X), 143 | ?Q(["case _@Expr of", 144 | " 0 -> 1;", 145 | " _ -> 0", 146 | "end"]). 147 | 148 | bool(true) -> 1; 149 | bool(false) -> 0. 150 | -------------------------------------------------------------------------------- /examples/lisp.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Trivial Lisp interpreter in Erlang. 15 | 16 | -module(lisp). 17 | 18 | -export([eval/1]). 19 | 20 | -export([init/0, equal/2, gt/2, knot/1]). 21 | 22 | -record(st, {env}). 23 | 24 | -define(INTERPRETED, true). 25 | -include("lisp_test.erl"). 26 | 27 | eval(P) -> 28 | {X, _} = eval(P, init()), 29 | X. 30 | 31 | init() -> 32 | Env = [{print, {builtin, fun do_print/2}} 33 | ,{list, {builtin, fun do_list/2}} 34 | ,{apply, {builtin, fun do_apply/2}} 35 | ,{plus, {builtin, fun do_plus/2}} 36 | ,{equal, {builtin, fun do_equal/2}} 37 | ,{gt, {builtin, fun do_gt/2}} 38 | ,{knot, {builtin, fun do_knot/2}} 39 | ,{y, y()} 40 | ], 41 | #st{env=dict:from_list(Env)}. 42 | 43 | eval([lambda, Ps, B], #st{env=E}=St) when is_list(Ps) -> 44 | case lists:all(fun is_atom/1, Ps) andalso 45 | (length(Ps) =:= length(lists:usort(Ps))) of 46 | true -> {{lambda, Ps, B, E}, St}; 47 | false -> throw(bad_lambda) 48 | end; 49 | eval([lambda | _], _) -> 50 | throw(bad_lambda); 51 | eval([def, A, V, B], #st{env=E0}=St) when is_atom(A) -> 52 | {V1, St1} = eval(V, St), 53 | E1 = bind(A, V1, E0), 54 | {X, St2} = eval(B, St1#st{env=E1}), 55 | {X, St2#st{env=E0}}; 56 | eval([def | _], _) -> 57 | throw(bad_def); 58 | eval([quote, A], St) -> 59 | {A, St}; 60 | eval([quote | _], _) -> 61 | throw(bad_quote); 62 | eval([iff, X, A, B], St) -> 63 | case eval(X, St) of 64 | {[], St1} -> eval(B, St1); 65 | {_, St1} -> eval(A, St1) 66 | end; 67 | eval([do], _St0) -> 68 | throw(bad_do); 69 | eval([do | As], St0) -> 70 | lists:foldl(fun (X, {_,St}) -> eval(X, St) end, {[],St0}, As); 71 | eval([_|_]=L, St) -> 72 | {[F | As], St1} = lists:mapfoldl(fun eval/2, St, L), 73 | call(F, As, St1); 74 | eval(A, St) when is_atom(A) -> 75 | {deref(A, St), St}; 76 | eval(C, St) -> 77 | {C, St}. 78 | 79 | %% UTILITY FUNCTIONS 80 | 81 | deref(A, #st{env=E}) -> 82 | case dict:find(A, E) of 83 | {ok, V} -> V; 84 | error -> throw({undefined, A}) 85 | end. 86 | 87 | bind(A, V, E) -> 88 | dict:store(A, V, E). 89 | 90 | bind_args([P | Ps], [A | As], E) -> 91 | bind_args(Ps, As, dict:store(P, A, E)); 92 | bind_args([], [], E) -> 93 | E; 94 | bind_args(_, _, _) -> 95 | throw(bad_arity). 96 | 97 | call({lambda, Ps, B, E}, As, #st{env=E0}=St) -> 98 | {X, St1} = eval(B, St#st{env=bind_args(Ps, As, E)}), 99 | {X, St1#st{env=E0}}; 100 | call({builtin, F}, As, St) -> 101 | F(As, St); 102 | call(X, _, _) -> 103 | throw({bad_fun, X}). 104 | 105 | bool(true) -> 1; 106 | bool(false) -> []. 107 | 108 | %% BUILTINS 109 | 110 | y() -> 111 | {Y, _} = eval([lambda, [f], 112 | [[lambda, [x], [f, [lambda, [y], [[x, x], y]]]], 113 | [lambda, [x], [f, [lambda, [y], [[x, x], y]]]]]], 114 | #st{env=dict:new()}), 115 | Y. 116 | 117 | do_print([S | Xs], St) -> 118 | io:format(S, Xs), 119 | {[], St}; 120 | do_print(_, _) -> 121 | throw(bad_print). 122 | 123 | do_list(As, St) -> 124 | {As, St}. 125 | 126 | do_apply([F, As], St) -> 127 | call(F, As, St); 128 | do_apply(_, _) -> 129 | throw(bad_apply). 130 | 131 | do_plus([X, Y], St) when is_number(X), is_number(Y) -> 132 | {X + Y, St}; 133 | do_plus(As, _) -> 134 | throw({bad_plus, As}). 135 | 136 | do_equal([X, Y], St) -> 137 | {equal(X, Y), St}; 138 | do_equal(As, _) -> 139 | throw({bad_equal, As}). 140 | 141 | equal(X, Y) -> 142 | bool(X =:= Y). 143 | 144 | do_gt([X, Y], St) -> 145 | {gt(X, Y), St}; 146 | do_gt(As, _) -> 147 | throw({bad_gt, As}). 148 | 149 | gt(X, Y) -> 150 | bool(X > Y). 151 | 152 | do_knot([X], St) -> 153 | {knot(X), St}; 154 | do_knot(As, _) -> 155 | throw({bad_gt, As}). 156 | 157 | knot([]) -> 158 | 1; 159 | knot(_) -> 160 | []. 161 | -------------------------------------------------------------------------------- /examples/lisp_test.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Tests. For including in another module. 15 | 16 | %-module(lisp_test). 17 | %-import(lisp, eval/1) 18 | 19 | -export([fib/1, lisp_fib/1]). 20 | 21 | -include_lib("eunit/include/eunit.hrl"). 22 | 23 | basics_test_() -> 24 | [?_assertEqual(42, eval(42)), 25 | ?_assertEqual("hello", eval([quote, "hello"])), 26 | ?_assertEqual(print, eval([quote, print])), 27 | ?_assertMatch([17,[1,2],42], eval([list,17,[list,1,2],42])), 28 | ?_assertEqual([], eval([print, [quote, "hello ~w"], [list, 42]])), 29 | ?_assertEqual(5, eval([plus, 2, 3])), 30 | ?_assertEqual(5, eval([plus, 8, -3])), 31 | ?_assertEqual([], eval([equal, 0, 1])), 32 | ?_assertEqual(1, eval([equal, 1, 1])), 33 | ?_assertEqual([], eval([gt, 0, 1])), 34 | ?_assertEqual([], eval([gt, 1, 1])), 35 | ?_assertEqual(1, eval([gt, 2, 1])), 36 | ?_assertEqual([], eval([knot, 42])), 37 | ?_assertEqual(1, eval([knot, []])), 38 | ?_assertEqual(42, eval([do, 17, 42])), 39 | ?_assertEqual([], eval([apply, print, [quote, ["~p", [42]]]])), 40 | ?_assertEqual(42, eval([iff, [], 17, 42])), 41 | ?_assertEqual(17, eval([iff, 1, 17, 42])), 42 | ?_assertEqual(42, eval([iff, [], [apply], 42])), 43 | ?_assertEqual(17, eval([iff, 1, 17, [apply]])), 44 | ?_assertEqual(17, eval([def, foo, 17, foo])), 45 | ?_assertEqual(17, eval([def, bar, 42, [def, foo, 17, foo]])), 46 | ?_assertEqual(42, eval([def, bar, 42, [def, foo, 17, bar]])), 47 | ?_assertEqual(17, eval([def, foo, 42, [def, foo, 17, foo]])) 48 | ]. 49 | 50 | -ifdef(INTERPRETED). 51 | interpreter_basics_test_() -> 52 | [?_assertThrow({undefined, foo}, eval(foo)), 53 | ?_assertMatch({builtin,_}, eval(print)), 54 | ?_assertThrow(bad_do, eval([do])), 55 | ?_assertThrow(bad_apply, eval([apply])), 56 | ?_assertThrow({undefined, foo}, eval([def, bar, 17, foo])) 57 | ]. 58 | 59 | interpreter_lambda_test_() -> 60 | [?_assertMatch({lambda,_,_,_}, eval([lambda, [], 42])), 61 | ?_assertMatch({lambda,_,_,_}, eval([lambda, [x], x])), 62 | ?_assertMatch({lambda,_,_,_}, eval([lambda, [x,y], 42])) 63 | ]. 64 | -endif. 65 | 66 | lambda_test_() -> 67 | [?_assertThrow(bad_lambda, eval([lambda])), 68 | ?_assertThrow(bad_lambda, eval([lambda, []])), 69 | ?_assertThrow(bad_lambda, eval([lambda, [], 17, 42])), 70 | ?_assertThrow(bad_lambda, eval([lambda, 17, 42])), 71 | ?_assertThrow(bad_lambda, eval([lambda, [17], 42])), 72 | ?_assertThrow(bad_lambda, eval([lambda, [foo, foo], 42])), 73 | ?_assertEqual(42, eval([[lambda, [x], x], 42])), 74 | ?_assertEqual([42, 17], eval([[lambda, [x], [list, x, 17]], 42])), 75 | ?_assertEqual([42, 17], eval([def, f, [def, y, 42, 76 | [lambda, [x], [list, y, x]]], 77 | [f, 17]])) 78 | ]. 79 | 80 | fib_test_() -> 81 | [?_assertEqual(fib(N), lisp_fib(N)) || N <- lists:seq(1,15) 82 | ]. 83 | 84 | 85 | fib(N) when N > 1 -> 86 | fib(N-1) + fib(N-2); 87 | fib(_) -> 88 | 1. 89 | 90 | lisp_fib(N) -> 91 | eval([def, fib, 92 | [y, [lambda, [f], [lambda, [x], 93 | [iff, [gt, x, 1], 94 | [plus, [f, [plus,x,-1]], [f, [plus,x,-2]]], 95 | 1] 96 | ]]], 97 | [fib, N] 98 | ]). 99 | -------------------------------------------------------------------------------- /examples/lispc.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Lisp compiler in Erlang. 15 | 16 | -module(lispc). 17 | 18 | -export([eval/1]). 19 | 20 | -record(st, {}). 21 | 22 | -include("lisp_test.erl"). 23 | 24 | -include("../include/merl.hrl"). 25 | 26 | eval(Lisp) -> 27 | compile(Lisp, tmp), 28 | tmp:eval(). 29 | 30 | compile(Lisp, ModName) -> 31 | {Code, _} = gen(Lisp, #st{}), 32 | Main = ?Q(["() ->", 33 | " __print = fun (S, Xs) -> io:format(S,Xs), [] end,", 34 | " __apply = fun erlang:apply/2,", 35 | " __plus = fun erlang:'+'/2,", 36 | " __equal = fun lisp:equal/2,", 37 | " __gt = fun lisp:gt/2,", 38 | " __knot = fun lisp:knot/1,", 39 | " __y = fun (F) ->", 40 | " (fun (X) -> F(fun (Y) -> (X(X))(Y) end) end)", 41 | " (fun (X) -> F(fun (Y) -> (X(X))(Y) end) end)", 42 | " end,", 43 | " _@Code"]), 44 | Forms = merl_build:module_forms( 45 | merl_build:add_function(true, eval, [Main], 46 | merl_build:init_module(ModName))), 47 | %% %% Write source to file for debugging 48 | %% file:write_file(lists:concat([ModName, "_gen.erl"]), 49 | %% erl_prettypr:format(erl_syntax:form_list(Forms), 50 | %% [{paper,160},{ribbon,80}])), 51 | merl:compile_and_load(Forms, [verbose]). 52 | 53 | var(Atom) -> 54 | merl:var(list_to_atom("__" ++ atom_to_list(Atom))). 55 | 56 | gen([lambda, Ps, B], St) when is_list(Ps) -> 57 | case lists:all(fun is_atom/1, Ps) andalso 58 | (length(Ps) =:= length(lists:usort(Ps))) of 59 | true -> 60 | Vars = [var(P) || P <- Ps], 61 | {Body, St1} = gen(B, St), 62 | {?Q("fun (_@Vars) -> _@Body end"), St1}; 63 | false -> 64 | throw(bad_lambda) 65 | end; 66 | gen([lambda | _], _) -> 67 | throw(bad_lambda); 68 | gen([def, A, V, B], St) when is_atom(A) -> 69 | Var = var(A), 70 | {Val, St1} = gen(V, St), 71 | {Body, St2} = gen(B, St1), 72 | {?Q("(fun (_@Var) -> _@Body end)(_@Val)"), St2}; 73 | gen([def | _], _) -> 74 | throw(bad_def); 75 | gen([quote, A], St) -> 76 | {merl:term(A), St}; 77 | gen([quote | _], _) -> 78 | throw(bad_quote); 79 | gen([iff, X, A, B], St) -> 80 | {Cond, St1} = gen(X, St), 81 | {True, St2} = gen(A, St1), 82 | {False, St3} = gen(B, St2), 83 | {?Q(["case _@Cond of", 84 | " [] -> _@False;", 85 | " _ -> _@True", 86 | "end"]), 87 | St3}; 88 | gen([do], _) -> 89 | throw(bad_do); 90 | gen([do | As], St0) -> 91 | {Body, St1} = lists:mapfoldl(fun gen/2, St0, As), 92 | {?Q("begin _@Body end"), St1}; 93 | gen([list | As], St0) -> 94 | {Elem, St1} = lists:mapfoldl(fun gen/2, St0, As), 95 | {?Q("[ _@Elem ]"), St1}; 96 | gen([_|_]=L, St) -> 97 | {[F | As], St1} = lists:mapfoldl(fun gen/2, St, L), 98 | {?Q("((_@F)(_@As))"), St1}; 99 | gen(A, St) when is_atom(A) -> 100 | {var(A), St}; 101 | gen(C, St) -> 102 | {merl:term(C), St}. 103 | -------------------------------------------------------------------------------- /examples/merl_build.erl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 3 | %% not use this file except in compliance with the License. You may obtain 4 | %% a copy of the License at 5 | %% 6 | %% Unless required by applicable law or agreed to in writing, software 7 | %% distributed under the License is distributed on an "AS IS" BASIS, 8 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 9 | %% See the License for the specific language governing permissions and 10 | %% limitations under the License. 11 | %% 12 | %% @author Richard Carlsson 13 | %% @copyright 2012 Richard Carlsson 14 | %% @doc Making it simple to build a module with merl 15 | 16 | -module(merl_build). 17 | 18 | -export([init_module/1, module_forms/1, add_function/4, add_record/3, 19 | add_import/3, add_attribute/3, set_file/2]). 20 | 21 | -import(merl, [term/1]). 22 | 23 | -include("../include/merl.hrl"). 24 | 25 | -type filename() :: string(). 26 | 27 | -record(module, { name :: atom() 28 | , file :: filename() 29 | , exports=[] :: [{atom(), integer()}] 30 | , imports=[] :: [{atom(), [{atom(), integer()}]}] 31 | , attributes=[] :: [{filename(), atom(), [term()]}] 32 | , records=[] :: [{filename(), atom(), 33 | [{atom(), merl:tree()}]}] 34 | , functions=[] :: [{filename(), atom(), [merl:tree()]}] 35 | }). 36 | 37 | %% TODO: init module from a list of forms (from various sources) 38 | 39 | %% @doc Create a new module representation, using the given module name. 40 | init_module(Name) when is_atom(Name) -> 41 | %% use the module name as the default file name - better than nothing 42 | #module{name=Name, file=atom_to_list(Name)}. 43 | 44 | %% @doc Get the list of syntax tree forms for a module representation. This can 45 | %% be passed to compile/2. 46 | module_forms(#module{name=Name, 47 | exports=Xs, 48 | imports=Is, 49 | records=Rs, 50 | attributes=As, 51 | functions=Fs}) 52 | when is_atom(Name), Name =/= undefined -> 53 | Module = ?Q("-module('@Name@')."), 54 | Exported = [erl_syntax:arity_qualifier(term(N), term(A)) 55 | || {N,A} <- ordsets:from_list(Xs)], 56 | Export = ?Q("-export(['@_Exported'/1])."), 57 | Imports = [?Q("-import('@M@', ['@_NAs'/1]).") 58 | || {M, Ns} <- Is, 59 | NAs <- [[erl_syntax:arity_qualifier(term(N), term(A)) 60 | || {N,A} <- ordsets:from_list(Ns)]] 61 | ], 62 | Attrs = [?Q("-file(\"'@File@\",1). -'@N@'('@T@').") 63 | || {File, N, T} <- lists:reverse(As)], 64 | Records = [?Q("-file(\"'@File@\",1). -record('@N@',{'@_RFs'=[]}).") 65 | || {File, N, Es} <- lists:reverse(Rs), 66 | RFs <- [[erl_syntax:record_field(term(F), V) 67 | || {F,V} <- Es]] 68 | ], 69 | Functions = [?Q("-file(\"'@File@\",1). '@_F'() -> [].") 70 | || {File, N, Cs} <- lists:reverse(Fs), 71 | F <- [erl_syntax:function(term(N), Cs)]], 72 | lists:flatten([Module, Export, Imports, Attrs, Records, Functions]). 73 | 74 | %% @doc Set the source file name for all subsequently added functions, 75 | %% records, and attributes. 76 | set_file(Filename, #module{}=M) -> 77 | M#module{file=filename:flatten(Filename)}. 78 | 79 | %% @doc Add a function to a module representation. 80 | add_function(Exported, Name, Clauses, 81 | #module{file=File, exports=Xs, functions=Fs}=M) 82 | when is_boolean(Exported), is_atom(Name), Clauses =/= [] -> 83 | Arity = length(erl_syntax:clause_patterns(hd(Clauses))), 84 | Xs1 = case Exported of 85 | true -> [{Name,Arity} | Xs]; 86 | false -> Xs 87 | end, 88 | M#module{exports=Xs1, functions=[{File, Name, Clauses} | Fs]}. 89 | 90 | %% @doc Add a record declaration to a module representation. 91 | add_record(Name, Fields, #module{file=File, records=Rs}=M) 92 | when is_atom(Name) -> 93 | M#module{records=[{File, Name, Fields} | Rs]}. 94 | 95 | %% @doc Add a "wild" attribute, such as `-compile(Opts)' to a module 96 | %% representation. Note that such attributes can only have a single argument. 97 | add_attribute(Name, Term, #module{file=File, attributes=As}=M) 98 | when is_atom(Name) -> 99 | M#module{attributes=[{File, Name, Term} | As]}. 100 | 101 | %% @doc Add an import declaration to a module representation. 102 | add_import(From, Names, #module{imports=Is}=M) 103 | when is_atom(From), is_list(Names) -> 104 | M#module{imports=[{From, Names} | Is]}. 105 | -------------------------------------------------------------------------------- /include/merl.hrl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% Header file for merl 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 5 | %% not use this file except in compliance with the License. You may obtain 6 | %% a copy of the License at 7 | %% 8 | %% Unless required by applicable law or agreed to in writing, software 9 | %% distributed under the License is distributed on an "AS IS" BASIS, 10 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 11 | %% See the License for the specific language governing permissions and 12 | %% limitations under the License. 13 | 14 | -ifndef(MERL_HRL). 15 | 16 | 17 | %% Quoting a piece of code 18 | -define(Q(Text), merl:quote(?LINE, Text)). 19 | 20 | %% Quasi-quoting code, substituting metavariables listed in Env 21 | -define(Q(Text, Env), merl:qquote(?LINE, Text, Env)). 22 | 23 | 24 | -ifndef(MERL_NO_TRANSFORM). 25 | -compile({parse_transform, merl_transform}). 26 | -endif. 27 | 28 | 29 | -endif. 30 | -------------------------------------------------------------------------------- /priv/.gitignore: -------------------------------------------------------------------------------- 1 | *.beam 2 | -------------------------------------------------------------------------------- /src/merl.erl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/richcarl/merl/edde1202635479075f13ca240ae85c95e591a142/src/merl.erl -------------------------------------------------------------------------------- /src/merl_tests.erl: -------------------------------------------------------------------------------- 1 | %% -*- coding: latin-1 -*- 2 | %% --------------------------------------------------------------------- 3 | %% Licensed under the Apache License, Version 2.0 (the "License"); you may 4 | %% not use this file except in compliance with the License. You may obtain 5 | %% a copy of the License at 6 | %% 7 | %% Unless required by applicable law or agreed to in writing, software 8 | %% distributed under the License is distributed on an "AS IS" BASIS, 9 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10 | %% See the License for the specific language governing permissions and 11 | %% limitations under the License. 12 | %% 13 | %% @author Richard Carlsson 14 | %% @copyright 2012 Richard Carlsson 15 | %% @doc Unit tests for merl. 16 | %% @private 17 | 18 | -module(merl_tests). 19 | 20 | %-define(MERL_NO_TRANSFORM, true). 21 | -include("../include/merl.hrl"). 22 | 23 | -include_lib("eunit/include/eunit.hrl"). 24 | 25 | 26 | %% utilities 27 | 28 | f(Ts) when is_list(Ts) -> 29 | lists:flatmap(fun erl_prettypr:format/1, Ts); 30 | f(T) -> 31 | erl_prettypr:format(T). 32 | 33 | fe(Env) -> [{Key, f(T)} || {Key, T} <- Env]. 34 | 35 | g_exported_() -> 36 | %% for testing the parse transform, autoexported to avoid complaints 37 | {ok, merl:quote(?LINE, "42")}. 38 | 39 | 40 | ok({ok, X}) -> X. 41 | 42 | 43 | %% 44 | %% tests 45 | %% 46 | 47 | parse_error_test_() -> 48 | [?_assertThrow({error, "1: syntax error before: '{'" ++ _}, 49 | f(merl:quote("{"))) 50 | ]. 51 | 52 | term_test_() -> 53 | [?_assertEqual(tuple, erl_syntax:type(merl:term({}))), 54 | ?_assertEqual("{foo, 42}", f(merl:term({foo, 42}))) 55 | ]. 56 | 57 | quote_form_test_() -> 58 | [?_assertEqual("f(X) -> {ok, X}.", 59 | f(?Q("f(X) -> {ok, X}."))), 60 | ?_assertEqual("-module(foo).", 61 | f(?Q("-module(foo)."))), 62 | ?_assertEqual("-import(bar, [f/1, g/2]).", 63 | f(?Q("-import(bar, [f/1, g/2])."))), 64 | ?_assertEqual(("-module(foo)." 65 | "-export([f/1])." 66 | "f(X) -> {ok, X}."), 67 | f(?Q(["-module(foo).", 68 | "-export([f/1]).", 69 | "f(X) -> {ok, X}."]))) 70 | ]. 71 | 72 | quote_term_test_() -> 73 | [?_assertEqual("foo", 74 | f(?Q("foo"))), 75 | ?_assertEqual("42", 76 | f(?Q("42"))), 77 | ?_assertEqual("{foo, 42}", 78 | f(?Q("{foo, 42}"))), 79 | ?_assertEqual(("1" ++ "2" ++ "3"), 80 | f(?Q("1, 2, 3"))), 81 | ?_assertEqual(("foo" "42" "{}" "true"), 82 | f(?Q("foo, 42, {}, (true)"))) 83 | ]. 84 | 85 | quote_expr_test_() -> 86 | [?_assertEqual("2 + 2", 87 | f(?Q("2 + 2"))), 88 | ?_assertEqual("f(foo, 42)", 89 | f(?Q("f(foo, 42)"))), 90 | ?_assertEqual("case X of\n a -> 1;\n b -> 2\nend", 91 | f(?Q("case X of a -> 1; b -> 2 end"))), 92 | ?_assertEqual(("2 + 2" ++ "f(42)" ++ "catch 22"), 93 | f(?Q("2 + 2, f(42), catch 22"))) 94 | ]. 95 | 96 | quote_try_clause_test_() -> 97 | [?_assertEqual("(error:R) when R =/= foo -> ok", 98 | f(?Q("error:R when R =/= foo -> ok"))), 99 | %% note that without any context, clauses are printed as fun-clauses 100 | ?_assertEqual(("(error:badarg) -> badarg" 101 | "(exit:normal) -> normal" 102 | "(_) -> other"), 103 | f(?Q(["error:badarg -> badarg;", 104 | "exit:normal -> normal;" 105 | "_ -> other"]))) 106 | ]. 107 | 108 | quote_fun_clause_test_() -> 109 | [?_assertEqual("(X, Y) when X < Y -> {ok, X}", 110 | f(?Q("(X, Y) when X < Y -> {ok, X}"))), 111 | ?_assertEqual(("(X, Y) when X < Y -> less" 112 | "(X, Y) when X > Y -> greater" 113 | "(_, _) -> equal"), 114 | f(?Q(["(X, Y) when X < Y -> less;", 115 | "(X, Y) when X > Y -> greater;" 116 | "(_, _) -> equal"])))]. 117 | 118 | quote_case_clause_test_() -> 119 | [?_assertEqual("({X, Y}) when X < Y -> X", 120 | f(?Q("{X, Y} when X < Y -> X"))), 121 | ?_assertEqual(("({X, Y}) when X < Y -> -1" 122 | "({X, Y}) when X > Y -> 1" 123 | "(_) -> 0"), 124 | f(?Q(["{X, Y} when X < Y -> -1;", 125 | "{X, Y} when X > Y -> 1;" 126 | "_ -> 0"])))]. 127 | 128 | quote_comment_test_() -> 129 | [?_assertEqual("%% comment preserved\n" 130 | "{foo, 42}", 131 | f(?Q(["%% comment preserved", 132 | "{foo, 42}"]))), 133 | ?_assertEqual("{foo, 42}" 134 | "%% comment preserved\n", 135 | f(?Q(["{foo, 42}", 136 | "%% comment preserved"]))), 137 | ?_assertEqual(" % just a comment (with indent)\n", 138 | f(?Q(" % just a comment (with indent)"))) 139 | ]. 140 | 141 | metavar_test_() -> 142 | [?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("'@foo'"))))), 143 | ?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("_@foo"))))), 144 | ?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("\"'@foo\""))))), 145 | ?_assertEqual("{'@foo'}", f(merl:tree(merl:template(?Q("{_@foo}"))))), 146 | ?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("{_@_foo}"))))), 147 | ?_assertEqual("909123", f(merl:tree(merl:template(?Q("{9090123}"))))), 148 | ?_assertEqual("{'@foo'}", 149 | f(merl:tree(merl:template(?Q("{{{_@__foo}}}"))))), 150 | ?_assertEqual("{909123}", 151 | f(merl:tree(merl:template(?Q("{{{90900123}}}"))))), 152 | ?_assertEqual("{'@@foo'}", 153 | f(merl:tree(merl:template(?Q("{{{_@__@foo}}}"))))), 154 | ?_assertEqual("{9099123}", 155 | f(merl:tree(merl:template(?Q("{{{909009123}}}"))))) 156 | ]. 157 | 158 | subst_test_() -> 159 | [?_assertEqual("42", 160 | f(merl:subst(?Q("_@foo"), [{foo, merl:term(42)}]))), 161 | ?_assertEqual("'@foo'", 162 | f(merl:subst(?Q("_@foo"), []))), 163 | ?_assertEqual("{42}", 164 | f(merl:subst(?Q("{_@foo}"), 165 | [{foo, merl:term(42)}]))), 166 | ?_assertEqual("{'@foo'}", 167 | f(merl:subst(?Q("{_@foo}"), []))), 168 | ?_assertEqual("fun bar/0", 169 | f(merl:subst(merl:template(?Q("fun '@foo'/0")), 170 | [{foo, merl:term(bar)}]))), 171 | ?_assertEqual("fun foo/3", 172 | f(merl:subst(merl:template(?Q("fun foo/9091")), 173 | [{1, merl:term(3)}]))), 174 | ?_assertEqual("[42]", 175 | f(merl:subst(merl:template(?Q("[_@foo]")), 176 | [{foo, merl:term(42)}]))), 177 | ?_assertEqual("[foo, bar]", 178 | f(merl:subst(merl:template(?Q("[_@foo]")), 179 | [{foo, [merl:term(foo),merl:term(bar)]}]))), 180 | ?_assertEqual("{fee, fie, foe, fum}", 181 | f(merl:subst(merl:template(?Q("{fee, _@foo, fum}")), 182 | [{foo, [merl:term(fie),merl:term(foe)]}]))), 183 | ?_assertEqual("[foo, bar]", 184 | f(merl:subst(merl:template(?Q("[_@@foo]")), 185 | [{foo, [merl:term(foo),merl:term(bar)]}]))), 186 | ?_assertEqual("{fee, fie, foe, fum}", 187 | f(merl:subst(merl:template(?Q("{fee, _@@foo, fum}")), 188 | [{foo, [merl:term(fie),merl:term(foe)]}]))), 189 | ?_assertEqual("['@@foo']", 190 | f(merl:subst(merl:template(?Q("[_@@foo]")), []))), 191 | ?_assertEqual("foo", 192 | f(merl:subst(merl:template(?Q("[_@_foo]")), 193 | [{foo, merl:term(foo)}]))), 194 | ?_assertEqual("{'@foo'}", 195 | f(merl:subst(merl:template(?Q("{[_@_foo]}")), []))), 196 | ?_assertEqual("{'@@foo'}", 197 | f(merl:subst(merl:template(?Q("{[_@_@foo]}")), []))), 198 | ?_assertEqual("-export([foo/1, bar/2]).", 199 | f(merl:subst(merl:template(?Q("-export(['@_@foo'/0]).")), 200 | [{foo, [erl_syntax:arity_qualifier( 201 | merl:term(foo), 202 | merl:term(1)), 203 | erl_syntax:arity_qualifier( 204 | merl:term(bar), 205 | merl:term(2)) 206 | ]} 207 | ]))) 208 | ]. 209 | 210 | match_test_() -> 211 | [?_assertEqual({ok, []}, merl:match(?Q("foo"), ?Q("foo"))), 212 | ?_assertEqual(error, merl:match(?Q("foo"), ?Q("bar"))), 213 | ?_assertEqual({ok,[]}, merl:match(?Q("{foo,42}"), ?Q("{foo,42}"))), 214 | ?_assertEqual(error, merl:match(?Q("{foo,42}"), ?Q("{foo,bar}"))), 215 | ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[42]]"), ?Q("[foo,[42]]"))), 216 | ?_assertEqual(error, merl:match(?Q("[foo,[42]]"), ?Q("[foo,{42}]"))), 217 | ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[_@_]]"), 218 | ?Q("[foo,[42]]"))), 219 | ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[9090]]"), 220 | ?Q("[foo,[42]]"))), 221 | ?_assertEqual({ok,[]}, merl:match(?Q("{_@_,[_@_,2]}"), 222 | ?Q("{foo,[1,2]}"))), 223 | ?_assertEqual(error, merl:match(?Q("{_@_,[_@_,2]}"), 224 | ?Q("{foo,[1,3]}"))), 225 | ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[9090,9090]]"), 226 | ?Q("[foo,[1,2]]"))), 227 | ?_assertEqual(error, merl:match(?Q("[foo,[9090,9090]]"), 228 | ?Q("[foo,[1,2,3]]"))), 229 | ?_assertEqual([{foo,"42"}], 230 | fe(ok(merl:match(?Q("_@foo"), ?Q("42"))))), 231 | ?_assertEqual([{foo,"42"}], 232 | fe(ok(merl:match(?Q("{_@foo}"), ?Q("{42}"))))), 233 | ?_assertEqual([{1,"0"},{foo,"bar"}], 234 | fe(ok(merl:match(?Q("fun '@foo'/9091"), 235 | ?Q("fun bar/0"))))), 236 | ?_assertEqual([{line,"17"},{text,"\"hello\""}], 237 | fe(ok(merl:match(?Q("{_@line, _@text}"), 238 | ?Q("{17, \"hello\"}"))))), 239 | ?_assertEqual([{line,"17"},{text,"\"hello\""}], 240 | fe(ok(merl:match(?Q("foo(_@line, _@text)"), 241 | ?Q("foo(17, \"hello\")"))))), 242 | ?_assertEqual([{foo,""}], 243 | fe(ok(merl:match(?Q("f(_@@foo)"), 244 | ?Q("f()"))))), 245 | ?_assertEqual([{foo,"fee"}], 246 | fe(ok(merl:match(?Q("f(_@@foo)"), 247 | ?Q("f(fee)"))))), 248 | ?_assertEqual([{foo,"feefiefum"}], 249 | fe(ok(merl:match(?Q("f(_@@foo)"), 250 | ?Q("f(fee, fie, fum)"))))), 251 | ?_assertEqual([{foo,""}], 252 | fe(ok(merl:match(?Q("[_@@foo]"), 253 | ?Q("[]"))))), 254 | ?_assertEqual([{foo,"fee"}], 255 | fe(ok(merl:match(?Q("[_@@foo]"), 256 | ?Q("[fee]"))))), 257 | ?_assertEqual([{foo,"feefiefoefum"}], 258 | fe(ok(merl:match(?Q("[_@@foo]"), 259 | ?Q("[fee, fie, foe, fum]"))))), 260 | ?_assertEqual([{foo,""}], 261 | fe(ok(merl:match(?Q("{_@@foo}"), 262 | ?Q("{}"))))), 263 | ?_assertEqual([{foo,"fee"}], 264 | fe(ok(merl:match(?Q("{_@@foo}"), 265 | ?Q("{fee}"))))), 266 | ?_assertEqual([{foo,"feefiefoefum"}], 267 | fe(ok(merl:match(?Q("{_@@foo}"), 268 | ?Q("{fee, fie, foe, fum}"))))), 269 | ?_assertEqual([{foo,"fie"}], 270 | fe(ok(merl:match(?Q("{fee, _@@foo}"), 271 | ?Q("{fee, fie}"))))), 272 | ?_assertEqual([{foo,"fiefoefum"}], 273 | fe(ok(merl:match(?Q("{fee, _@@foo}"), 274 | ?Q("{fee, fie, foe, fum}"))))), 275 | ?_assertEqual([{foo,"fie"}], 276 | fe(ok(merl:match(?Q("{_@@foo, foe, fum}"), 277 | ?Q("{fie, foe, fum}"))))), 278 | ?_assertEqual([{foo,"feefie"}], 279 | fe(ok(merl:match(?Q("{_@@foo, foe, fum}"), 280 | ?Q("{fee, fie, foe, fum}"))))), 281 | ?_assertEqual([{foo,"fie"}], 282 | fe(ok(merl:match(?Q("{fee, _@@foo, fum}"), 283 | ?Q("{fee, fie, fum}"))))), 284 | ?_assertEqual([{foo,"fiefoe"}], 285 | fe(ok(merl:match(?Q("{fee, _@@foo, fum}"), 286 | ?Q("{fee, fie, foe, fum}"))))), 287 | ?_assertEqual([{foo,"fiefoe"},{post,"fum"},{pre,"fee"}], 288 | fe(ok(merl:match(?Q("{_@pre, _@@foo, _@post}"), 289 | ?Q("{fee, fie, foe, fum}"))))), 290 | ?_assertThrow({error, "multiple glob variables"++_}, 291 | fe(ok(merl:match(?Q("{_@@foo, _@@bar}"), 292 | ?Q("{fee, fie, foe, fum}"))))), 293 | ?_assertEqual([], 294 | fe(ok(merl:match(?Q("{fee, _@@_}"), 295 | ?Q("{fee, fie, foe, fum}"))))), 296 | ?_assertEqual([], 297 | fe(ok(merl:match(?Q("{_@@_, foe, fum}"), 298 | ?Q("{fee, fie, foe, fum}"))))), 299 | ?_assertEqual([{post,"fum"},{pre,"fee"}], 300 | fe(ok(merl:match(?Q("{_@pre, _@@_, _@post}"), 301 | ?Q("{fee, fie, foe, fum}"))))) 302 | ]. 303 | 304 | switch_test_() -> 305 | [?_assertEqual(42, merl:switch(?Q("foo"), [fun () -> 42 end])), 306 | ?_assertEqual(17, merl:switch(?Q("foo"), [fun () -> 17 end, 307 | fun () -> 42 end])), 308 | ?_assertEqual(17, merl:switch(?Q("foo"), [{?Q("foo"), 309 | fun ([]) -> 17 end}, 310 | fun () -> 42 end])), 311 | ?_assertEqual(17, 312 | merl:switch(?Q("foo"), [{?Q("bar"), fun ([]) -> 0 end}, 313 | {?Q("foo"), fun ([]) -> 17 end}, 314 | fun () -> 42 end])), 315 | ?_assertEqual([{foo,"17"}], 316 | merl:switch(?Q("{foo,17}"), 317 | [{?Q("{bar, _@foo}"), fun (_) -> 0 end}, 318 | {?Q("{foo, _@foo}"), fun fe/1}, 319 | fun () -> 42 end])), 320 | ?_assertEqual(17, 321 | merl:switch(?Q("{foo, 17}"), 322 | [{?Q("{foo, _@foo}"), 323 | fun ([{foo, X}]) -> f(X) =:= "17" end, 324 | fun (_) -> 17 end}, 325 | fun () -> 42 end])), 326 | ?_assertEqual([{foo,"17"}], 327 | merl:switch(?Q("{foo, 17}"), 328 | [{?Q("{foo, _@foo}"), 329 | fun ([{foo, X}]) -> f(X) =:= "42" end, 330 | fun (_) -> 0 end}, 331 | {?Q("{foo, _@foo}"), fun fe/1}, 332 | fun () -> 42 end])), 333 | ?_assertEqual(17, 334 | merl:switch(?Q("{foo, 17}"), 335 | [{?Q("{foo, _@foo}"), 336 | [{fun ([{foo, X}]) -> f(X) =:= "17" end, 337 | fun (_) -> 17 end}, 338 | fun (_) -> 0 end]}, 339 | fun () -> 42 end])), 340 | ?_assertEqual([{foo,"17"}], 341 | merl:switch(?Q("{foo, 17}"), 342 | [{?Q("{foo, _@foo}"), 343 | [{fun ([{foo, X}]) -> f(X) =:= "42" end, 344 | fun (_) -> 0 end}, 345 | fun fe/1]}, 346 | fun () -> 42 end])) 347 | ]. 348 | 349 | -ifndef(MERL_NO_TRANSFORM). 350 | 351 | inline_meta_test_() -> 352 | [?_assertEqual("{foo}", 353 | f(begin 354 | Foo = ?Q("foo"), 355 | ?Q("{_@Foo}") 356 | end)), 357 | ?_assertEqual("{foo, '@bar'}", 358 | f(begin 359 | Foo = ?Q("foo"), 360 | ?Q("{_@Foo,_@bar}") 361 | end)), 362 | ?_assertEqual("{foo, '@bar'}", 363 | f(begin 364 | Q1 = ?Q("foo"), 365 | ?Q("{90919,_@bar}") 366 | end)) 367 | ]. 368 | 369 | inline_meta_autoabstract_test_() -> 370 | [?_assertEqual("{foo}", 371 | f(begin 372 | Foo = foo, 373 | ?Q("{_@Foo@}") 374 | end)), 375 | ?_assertEqual("{foo, '@bar@'}", 376 | f(begin 377 | Foo = foo, 378 | ?Q("{_@Foo@,_@bar@}") 379 | end)), 380 | ?_assertEqual("{foo, '@bar@'}", 381 | f(begin 382 | Q1 = foo, 383 | ?Q("{909199,_@bar@}") 384 | end)) 385 | ]. 386 | 387 | meta_match_test_() -> 388 | [?_assertEqual("{[bar], baz()}", 389 | f(begin 390 | Tree = ?Q("{foo, [bar], baz()}"), 391 | ?Q("{foo, _@Bar, '@Baz'}") = Tree, 392 | ?Q("{_@Bar, _@Baz}") 393 | end)), 394 | ?_assertEqual("{[bar], baz()}", 395 | f(begin 396 | Tree = ?Q("{foo, [bar], baz()}"), 397 | ?Q("{foo, 90919, 90929}") = Tree, 398 | ?Q("{_@Q1, _@Q2}") 399 | end)), 400 | ?_assertError({badmatch,error}, 401 | f(begin 402 | Tree = ?Q("{foo, [bar], baz()}"), 403 | ?Q("{fie, _@Bar, '@Baz'}") = Tree, 404 | ?Q("{_@Bar, _@Baz}") 405 | end)) 406 | ]. 407 | 408 | meta_case_test_() -> 409 | [?_assertEqual("{[bar], baz()}", 410 | f(begin 411 | Tree = ?Q("{foo, [bar], baz()}"), 412 | case Tree of 413 | ?Q("{foo, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}") 414 | end 415 | end)), 416 | ?_assertEqual("{foo, [bar], baz()}", 417 | f(begin 418 | Tree = ?Q("{foo, [bar], baz()}"), 419 | case Tree of 420 | ?Q("{fie, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}"); 421 | _ -> Tree 422 | end 423 | end)), 424 | ?_assertError(merl_switch_clause, 425 | f(begin 426 | Tree = ?Q("{foo, [bar], baz()}"), 427 | case Tree of 428 | ?Q("{fie, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}") 429 | end 430 | end)), 431 | ?_assertEqual("{foo, 4}", 432 | f(begin 433 | Tree = ?Q("{foo, 3}"), 434 | case Tree of 435 | ?Q("{foo, _@N}") -> 436 | N1 = erl_syntax:concrete(N) + 1, 437 | ?Q("{foo, _@N1@}"); 438 | _ -> Tree 439 | end 440 | end)), 441 | ?_assertEqual("-export([f/4]).", 442 | f(begin 443 | Tree = ?Q("-export([f/3])."), 444 | case Tree of 445 | ?Q("-export([f/90919]).") -> 446 | Q2 = erl_syntax:concrete(Q1) + 1, 447 | ?Q("-export([f/909299])."); 448 | _ -> Tree 449 | end 450 | end)), 451 | ?_assertEqual("{1, [bar], baz()}", 452 | f(begin 453 | Tree = ?Q("{foo, [bar], baz()}"), 454 | case Tree of 455 | ?Q("{foo, _@Bar, '@Baz'}") -> 456 | ?Q("{1, _@Bar, _@Baz}"); 457 | ?Q("{fie, _@Bar, '@Baz'}") -> 458 | ?Q("{2, _@Bar, _@Baz}"); 459 | _ -> Tree 460 | end 461 | end)), 462 | ?_assertEqual("{2, [bar], baz()}", 463 | f(begin 464 | Tree = ?Q("{fie, [bar], baz()}"), 465 | case Tree of 466 | ?Q("{foo, _@Bar, '@Baz'}") -> 467 | ?Q("{1, _@Bar, _@Baz}"); 468 | ?Q("{fie, _@Bar, '@Baz'}") -> 469 | ?Q("{2, _@Bar, _@Baz}"); 470 | _ -> Tree 471 | end 472 | end)), 473 | ?_assertEqual("{2, baz()}", 474 | f(begin 475 | Tree = ?Q("{foo, [bar], baz()}"), 476 | case Tree of 477 | ?Q("{foo, [_@Bar], '@Baz'}") 478 | when erl_syntax:is_atom(Bar, foo) -> 479 | ?Q("{1, _@Baz}"); 480 | ?Q("{foo, [_@Bar], '@Baz'}") 481 | when erl_syntax:is_atom(Bar, bar) -> 482 | ?Q("{2, _@Baz}"); 483 | ?Q("{foo, [_@Bar], '@Baz'}") -> 484 | ?Q("{3, _@Baz}"); 485 | _ -> Tree 486 | end 487 | end)), 488 | ?_assertEqual("{2, 42}", 489 | f(begin 490 | Tree = ?Q("{foo, [bar], 42}"), 491 | case Tree of 492 | ?Q("{foo, [_@Bar], '@Baz'}") 493 | when erl_syntax:is_atom(Bar, bar), 494 | erl_syntax:is_integer(Baz, 17) -> 495 | ?Q("{1, _@Bar}"); 496 | ?Q("{foo, [_@Bar], '@Baz'}") 497 | when erl_syntax:is_atom(Bar, bar), 498 | erl_syntax:is_integer(Baz, 42) -> 499 | ?Q("{2, _@Baz}"); 500 | ?Q("{foo, [_@Bar], '@Baz'}") -> 501 | ?Q("{3, _@Baz}"); 502 | _ -> Tree 503 | end 504 | end)), 505 | ?_assertEqual("{2, 42}", 506 | f(begin 507 | Tree = ?Q("{foo, [baz], 42}"), 508 | case Tree of 509 | ?Q("{foo, [_@Bar], '@Baz'}") 510 | when erl_syntax:is_atom(Bar, bar), 511 | erl_syntax:is_integer(Baz, 17) 512 | ; erl_syntax:is_atom(Bar, baz), 513 | erl_syntax:is_integer(Baz, 17) -> 514 | ?Q("{1, _@Bar}"); 515 | ?Q("{foo, [_@Bar], '@Baz'}") 516 | when erl_syntax:is_atom(Bar, bar), 517 | erl_syntax:is_integer(Baz, 42) 518 | ; erl_syntax:is_atom(Bar, baz), 519 | erl_syntax:is_integer(Baz, 42) -> 520 | ?Q("{2, _@Baz}"); 521 | ?Q("{foo, [_@Bar], '@Baz'}") -> 522 | ?Q("{3, _@Baz}"); 523 | _ -> Tree 524 | end 525 | end)), 526 | ?_assertEqual("{2, foo, Bar, Baz, Bar(), Baz()}", 527 | f(begin 528 | Tree = ?Q("foo(Bar, Baz) -> Bar(), Baz()."), 529 | case Tree of 530 | ?Q("'@Func'(_@Args) -> _@Body.") -> 531 | ?Q("{1, _@Func, _@Args, _@Body}"); 532 | ?Q("'@Func'(_@@Args) -> _@@Body.") -> 533 | ?Q("{2, _@Func, _@Args, _@Body}"); 534 | ?Q("'@Func'(_@Args, Baz) -> _@Body1, _@Body2.") -> 535 | ?Q("{3, _@Func, _@Args, _@Body1, _@Body2}") 536 | end 537 | end)) 538 | ]. 539 | 540 | -endif. 541 | -------------------------------------------------------------------------------- /src/merl_transform.erl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/richcarl/merl/edde1202635479075f13ca240ae85c95e591a142/src/merl_transform.erl --------------------------------------------------------------------------------