├── .gitignore ├── Makefile ├── README.md ├── ebin └── .gitignore ├── examples ├── add.eml ├── anon.eml ├── case.eml ├── fac.eml ├── let.eml ├── let2.eml ├── let3.eml ├── letrec.eml ├── letrec2.eml ├── qsort.eml └── range.eml ├── include └── eml.hrl ├── rebar ├── rebar.config └── src ├── eml.app.src ├── eml.erl ├── eml_compile.erl ├── eml_lexer.xrl ├── eml_parser.yrl └── rebar_eml_plugin.erl /.gitignore: -------------------------------------------------------------------------------- 1 | .eunit/ 2 | deps/ 3 | src/eml_lexer.erl 4 | src/eml_parser.erl 5 | *~ 6 | ebin/*.beam 7 | ebin/*.app 8 | examples/*.erl 9 | examples/*.beam 10 | examples/*.compile 11 | examples/*.parse 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SHELL=/bin/bash 2 | ERL ?= erl 3 | APP := eml 4 | 5 | .PHONY: deps 6 | 7 | all: deps 8 | @./rebar compile 9 | 10 | deps: 11 | @./rebar get-deps 12 | 13 | examples: all 14 | @erl -pa ./ebin -noshell -s eml compile_examples -s init stop 15 | @(cd examples; erlc *.erl) 16 | 17 | clean: 18 | @./rebar clean 19 | @rm -f examples/*.erl examples/*.beam 20 | 21 | distclean: clean 22 | @./rebar delete-deps 23 | 24 | test: local_clean 25 | @./rebar eunit 26 | 27 | ct: all 28 | @./rebar -C rebar.config.test ct 29 | 30 | ct2: all 31 | @./rebar -C rebar.config.test ct 32 | 33 | ctv: all 34 | @./rebar -C rebar.config.test ct verbose=1 35 | 36 | local_clean: 37 | @rm -f ./ebin/* .eunit/* 38 | 39 | xref: all 40 | @./rebar xref 41 | 42 | docs: 43 | @erl -noshell -run edoc_run application '$(APP)' '"."' '[]' 44 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## eml - Erlang flavored by Some ML 2 | 3 | There are no Erlang receive,send or match expressions in EML. 4 | 5 | Instead there is let and a type of letrec construct as 6 | well as currying. Inspired from Haskel, there is also a way 7 | to express generation of a list of integers and to represent 8 | arithmetic operators as an anonymous function. 9 | Currently, only program transformation is done, mainly 10 | inspired by the classic SPJ book. 11 | 12 | Example 1: 13 | 14 | fun foo = 15 | let val X = [1,2,3] 16 | val Y = [a,b,c] 17 | rec Zip = fn [] [] => [] | fn [A|B] [H|T] => [{A,H} | Zip(B,T)] 18 | in Zip(X,Y); 19 | 20 | Example 2: 21 | 22 | fun double L = 23 | let val Mult2 = map(fn X => X * 2) 24 | in Mult2(L); 25 | 26 | fun map F [H|T] = 27 | let val Hd = F(H) 28 | val Tl = map(F,T) 29 | in 30 | [Hd|Tl] 31 | | map _ [] = []; 32 | 33 | Example 3: 34 | 35 | fun f3 N = foldl(@*, 1, [1..N]); 36 | 37 | fun foldl Fun Acc [H|T] = foldl(Fun, Fun(H,Acc), T) 38 | | foldl _ Acc [] = Acc; 39 | 40 | If you want to try it out you can either clone the 41 | [eml_examples.git][1] repo which setup the eml 42 | compiler as a rebar plugin, or set it up your self 43 | by adding the following to your rebar.config file: 44 | 45 | {deps_dir, ["deps"]}. 46 | {deps, [ 47 | {eml, "0.*", 48 | {git, "git@github.com:etnt/eml.git", 49 | "HEAD"}} 50 | ]}. 51 | {plugins, [ rebar_eml_plugin ]}. 52 | {plugin_dir, "deps/rebar_eml_plugin/src"}. 53 | 54 | [1]: https://github.com/etnt/eml_examples 55 | 56 | -------------------------------------------------------------------------------- /ebin/.gitignore: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/etnt/eml/d1f8fdeddfbba8f50250f2dc3e1d410a3c32ac0b/ebin/.gitignore -------------------------------------------------------------------------------- /examples/add.eml: -------------------------------------------------------------------------------- 1 | fun add X Y = X + Y; 2 | -------------------------------------------------------------------------------- /examples/anon.eml: -------------------------------------------------------------------------------- 1 | fun double L = 2 | let val Mult2 = map(fn X => X * 2) 3 | in Mult2(L); 4 | 5 | fun map F [H|T] = 6 | let val Hd = F(H) 7 | val Tl = map(F,T) 8 | in 9 | [Hd|Tl] 10 | | map _ [] = []; 11 | -------------------------------------------------------------------------------- /examples/case.eml: -------------------------------------------------------------------------------- 1 | fun is_even X = 2 | case X rem 2 of 3 | 0 => true 4 | | _ => false; 5 | -------------------------------------------------------------------------------- /examples/fac.eml: -------------------------------------------------------------------------------- 1 | fun f1 0 = 1 2 | | f1 N = N * f1(N-1); 3 | 4 | 5 | fun f2 N = 6 | let val Mult = fn X Y => X * Y 7 | in foldl(Mult, 1, lists:seq(1,N)); 8 | 9 | fun f3 N = foldl(@*, 1, [1..N]); 10 | 11 | fun foldl Fun Acc [H|T] = foldl(Fun, Fun(H,Acc), T) 12 | | foldl _ Acc [] = Acc; 13 | -------------------------------------------------------------------------------- /examples/let.eml: -------------------------------------------------------------------------------- 1 | 2 | fun split X = 3 | let val Even = [Y || Y <- X, (Y rem 2) == 0] 4 | val Odd = [Y || Y <- X, (Y rem 2) =/= 0] 5 | in 6 | {Even,Odd}; 7 | -------------------------------------------------------------------------------- /examples/let2.eml: -------------------------------------------------------------------------------- 1 | fun foo X Y = 2 | let val Z = X + Y + 4 3 | val W = X - Y 4 | in {Z,W}; 5 | -------------------------------------------------------------------------------- /examples/let3.eml: -------------------------------------------------------------------------------- 1 | fun foo X = 2 | let val Z = X + 1 3 | val Y = Z + X + 1 4 | in Y; 5 | 6 | -------------------------------------------------------------------------------- /examples/letrec.eml: -------------------------------------------------------------------------------- 1 | fun foo L = 2 | let rec Len = fn [] => 0 | fn [_|T] => 1 + Len(T) 3 | in Len(L); 4 | 5 | -------------------------------------------------------------------------------- /examples/letrec2.eml: -------------------------------------------------------------------------------- 1 | fun foo = 2 | let val X = [1,2,3] 3 | val Y = [a,b,c] 4 | rec Zip = fn [] [] => [] | fn [A|B] [H|T] => [{A,H} | Zip(B,T)] 5 | in Zip(X,Y); 6 | 7 | -------------------------------------------------------------------------------- /examples/qsort.eml: -------------------------------------------------------------------------------- 1 | fun qsort [H|T] = 2 | let val GrEq = qsort([X || X <- T, X >= H]) 3 | val Le = qsort([X || X <- T, X < H]) 4 | in 5 | GrEq ++ [H] ++ Le 6 | | qsort [] = []; 7 | -------------------------------------------------------------------------------- /examples/range.eml: -------------------------------------------------------------------------------- 1 | fun f From To By = [From..To by By]; 2 | -------------------------------------------------------------------------------- /include/eml.hrl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/etnt/eml/d1f8fdeddfbba8f50250f2dc3e1d410a3c32ac0b/include/eml.hrl -------------------------------------------------------------------------------- /rebar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/etnt/eml/d1f8fdeddfbba8f50250f2dc3e1d410a3c32ac0b/rebar -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | %%-*- mode: erlang -*- 2 | 3 | {deps_dir, ["deps"]}. 4 | 5 | {deps, [ 6 | {eper, "0.*", 7 | {git, "git://github.com/massemanet/eper.git", 8 | "HEAD"}} 9 | ]}. 10 | 11 | %% Erlang compiler options 12 | %{erl_opts, [{i, "include"}]}. 13 | 14 | %% Add this to a projects rebar.config which is using eml 15 | %{plugins, [ rebar_eml_plugin ]}. 16 | %{plugin_dir, "deps/rebar_eml_plugin/src"}. 17 | -------------------------------------------------------------------------------- /src/eml.app.src: -------------------------------------------------------------------------------- 1 | {application, eml, [ 2 | {description, "Erlang flavored by some ML."}, 3 | {vsn, "0.1.0"}, 4 | {env, []} 5 | ]}. 6 | -------------------------------------------------------------------------------- /src/eml.erl: -------------------------------------------------------------------------------- 1 | %% ------------------------------------------------------------------- 2 | %% Created: 22 Dec 2011 by etnt@redhoterlang.com 3 | %% 4 | %% @doc Erlang flavored by Some ML 5 | %% 6 | %% ------------------------------------------------------------------- 7 | -module(eml). 8 | 9 | -export([c/1 10 | , compiler/1 11 | , compile_examples/0 12 | , compile_file/1 13 | , compile_file/2 14 | , e/1 15 | , f/1 16 | , l/1 17 | , lexer/1 18 | , p/1 19 | , parse/1 20 | , parser/1 21 | , typecheck/1 22 | ]). 23 | 24 | -include("eml.hrl"). 25 | -include_lib("eunit/include/eunit.hrl"). 26 | 27 | compile_examples() -> 28 | Files = string:tokens(os:cmd("ls examples/*.eml"), "\n"), 29 | F = fun(File) -> 30 | {ok,_} = compile_file(File), 31 | io:format("Compiled file ~s~n",[File]) 32 | end, 33 | [F(File) || File <- Files]. 34 | 35 | compile_file(FileName) -> 36 | compile_file(FileName, []). 37 | 38 | compile_file(FileName, Opts) -> 39 | ModName = filename:basename(FileName,".eml"), 40 | DirName = filename:dirname(FileName), 41 | {ok,EmlForms} = parse(FileName), 42 | dump(FileName++".parse", EmlForms, Opts), 43 | CurryForms = eml_compile:curry(EmlForms), 44 | {ok,ErlForms} = compiler(CurryForms), 45 | dump(FileName++".compile", ErlForms, Opts), 46 | String = to_erl(ModName,ErlForms), 47 | file:write_file(filename:join([DirName,ModName++".erl"]), 48 | list_to_binary(String)), 49 | compile:file(filename:join([DirName,ModName]), Opts ++ [{outdir,DirName}]). 50 | 51 | to_erl(Module,Forms) when is_list(Module) -> 52 | Mx = erl_syntax:attribute(erl_syntax:atom("module"), 53 | [erl_syntax:atom(Module)]), 54 | 55 | Es = [erl_syntax:arity_qualifier( 56 | erl_syntax:atom(FunName), 57 | erl_syntax:integer(Arity)) 58 | || {function,_,FunName,Arity,_} <- Forms], 59 | 60 | Ex = erl_syntax:attribute( 61 | erl_syntax:atom("export"), 62 | [erl_syntax:list(Es)]), 63 | 64 | erl_prettypr:format(erl_syntax:form_list([Mx,Ex]++Forms)). 65 | 66 | 67 | dump(FileName, Data, Opts) -> 68 | case lists:keyfind(verbose,1,Opts) of 69 | {verbose,true} -> 70 | {ok,Fd} = file:open(FileName, write), 71 | io:format(Fd, "~p~n", [Data]), 72 | file:close(Fd); 73 | _ -> 74 | false 75 | end. 76 | 77 | 78 | f(FileName) -> 79 | {ok,Forms} = parse(FileName), 80 | eml_compile:curry(Forms). 81 | 82 | c(S) -> e2(compiler(e2(parser(e2(lexer(S)))))). 83 | e(S) -> eml_compile:erl_form(S). 84 | p(S) -> parser(e2(lexer(S))). 85 | l(S) -> lexer(S). 86 | 87 | 88 | lexer(String) when is_list(String) -> 89 | eml_lexer:string(String). 90 | 91 | parser(Tokens) when is_list(Tokens) -> 92 | eml_parser:parse(Tokens). 93 | 94 | typecheck(ParseTree) -> 95 | eml_typecheck:run(ParseTree). 96 | 97 | compiler(ParseTree) -> 98 | eml_compile:run(ParseTree). 99 | 100 | 101 | parse(FileName) -> 102 | {ok, InFile} = file:open(FileName, [read]), 103 | Acc = loop(InFile,[]), 104 | file:close(InFile), 105 | eml_parser:parse(Acc). 106 | 107 | loop(InFile,Acc) -> 108 | case io:request(InFile,{get_until,prompt,eml_lexer,token,[1]}) of 109 | {ok,Token,_EndLine} -> 110 | loop(InFile,Acc ++ [Token]); 111 | {error,token} -> 112 | exit(scanning_error); 113 | {eof,_} -> 114 | Acc 115 | end. 116 | 117 | 118 | 119 | -ifdef(EUNIT). 120 | 121 | compiler_test_() -> 122 | [ 123 | ?_assertEqual([e("add1(X) -> X + 1.")], 124 | c("fun add1 X = X + 1;")) 125 | 126 | ,?_assertEqual([e("len([H|T]) -> 1 + len(T);\nlen([]) -> 0.")], 127 | c("fun len [H|T] = 1 + len(T)\n| len [] = 0;")) 128 | 129 | ,?_assertEqual([e("add3(Y) -> fun (X) -> X + Y end(3).")], 130 | c("fun add3 Y = let val X = 3 in X + Y;")) 131 | 132 | ,?_assertEqual([e("expr(Y) -> ((fun (X) -> fun (Z) -> X*Y+Z end end)(2))(1).")], 133 | c("fun expr Y = let val X = 2 val Z = 1 in X*Y+Z;")) 134 | 135 | ,?_assertEqual([e("add(Y) -> (fun ({X,Z}) -> X + Z end)(Y).")], 136 | c("fun add Y = let val {X,Z} = Y in X + Z;")) 137 | 138 | ,?_assertEqual([e("add(X,Y) -> X + Y.")], 139 | c("fun add X Y = X + Y;")) 140 | 141 | ,?_assertEqual([e("qsort([H | T]) -> (fun (GrEq) -> fun (Le) -> GrEq ++ [H] ++ Le end end(qsort([X || X <- T, X >= H])))(qsort([X || X <- T, X < H])); qsort([]) -> [].")], 142 | c("fun qsort [H|T] = let val GrEq = qsort([X || X <- T, X >= H]) val Le = qsort([X || X <- T, X < H]) in GrEq ++ [H] ++ Le | qsort [] = [];")) 143 | 144 | ,?_assertEqual([eml:e("add(X) -> fun(Y) -> X + Y end.")], 145 | eml:c("fun add X = fn Y => X + Y;")) 146 | 147 | 148 | ]. 149 | 150 | 151 | parser_test_() -> 152 | [ 153 | 154 | 155 | ?_assertMatch({ok,[{function,1,foo,0, 156 | [{clause,1,[],[], 157 | [{call,1, 158 | {atom,1,foldl}, 159 | [{op_fun,1,'+'}, 160 | {integer,1,0}, 161 | {cons,1, 162 | {integer,1,1}, 163 | {cons,1, 164 | {integer,1,2}, 165 | {cons,1,{integer,1,3},{nil,1}}}}]}]}]}] 166 | }, 167 | p("fun foo = foldl(@+, 0, [1,2,3]);")) 168 | 169 | 170 | % ?_assertMatch({ok, 171 | % {function,1,len,1, 172 | % [{clause,1, 173 | % [{cons,1,{var,1,'H'},{var,1,'T'}}], 174 | % [], 175 | % [{op,1,'+', 176 | % {integer,1,1}, 177 | % {call,1,[],len,[{var,1,'T'}]}}]}, 178 | % {clause,2,[{nil,2}],[],[{integer,2,0}]}]}}, 179 | % 180 | % p("fun len [H|T] = 1 + len T\n| len [] = 0;")) 181 | 182 | 183 | % ,?_assertMatch({ok,{function,1,add,1, 184 | % [{clause,2, 185 | % [{var,1,'X'}], 186 | % [], 187 | % [{'let',2, 188 | % [{val,2,{var,2,'Y'},{integer,2,2}}], 189 | % [{op,2,'+', 190 | % {var,2,'X'}, 191 | % {var,2,'Y'}}]}]}]}}, 192 | % 193 | % p("fun add X =\n let val Y = 2 in X + Y;")) 194 | 195 | ]. 196 | 197 | lexer_test_() -> 198 | [ 199 | 200 | 201 | ?_assertMatch({ok,[{atom,1,len}, 202 | {'[',1}, 203 | {atom,1,h}, 204 | {'|',1}, 205 | {atom,1,t}, 206 | {']',1}, 207 | {'=',1}, 208 | {integer,1,1}, 209 | {'+',1}, 210 | {atom,1,len}, 211 | {atom,1,t}, 212 | {atom,2,len}, 213 | {'[',2}, 214 | {']',2}, 215 | {'=',2}, 216 | {integer,2,0}], 217 | 2}, 218 | l("len [h|t] = 1 + len t\nlen [] = 0")) 219 | 220 | ,?_assertMatch({ok,[{atom,1,foldl}, 221 | {'(',1}, 222 | {'@+',1}, 223 | {',',1}, 224 | {integer,1,0}, 225 | {',',1}, 226 | {'[',1}, 227 | {integer,1,1}, 228 | {',',1}, 229 | {integer,1,2}, 230 | {',',1}, 231 | {integer,1,3}, 232 | {']',1}, 233 | {')',1}], 234 | 1}, 235 | l("foldl(@+, 0, [1,2,3])")) 236 | 237 | ]. 238 | 239 | e2(T) when is_tuple(T) -> element(2, T). 240 | 241 | 242 | -endif. 243 | -------------------------------------------------------------------------------- /src/eml_compile.erl: -------------------------------------------------------------------------------- 1 | %% ------------------------------------------------------------------- 2 | %% Created: 22 Dec 2011 by etnt@redhoterlang.com 3 | %% 4 | %% @doc The compiler 5 | %% 6 | %% ------------------------------------------------------------------- 7 | 8 | -module(eml_compile). 9 | 10 | -export([curry/1 11 | , run/1 12 | , print/1 13 | , erl_form/1 14 | ]). 15 | 16 | -include("eml.hrl"). 17 | 18 | -define(e, erl_syntax). 19 | 20 | 21 | 22 | erl_form(ErlStr) -> 23 | {ok,Form} = erl_parse:parse_form(element(2,erl_scan:string(ErlStr))), 24 | Form. 25 | 26 | 27 | %%8> erl_parse:parse_form(element(2,erl_scan:string("add1(X) -> X + 1."))) 28 | %%. 29 | %%{ok,{function,1,add1,1, 30 | %% [{clause,1, 31 | %% [{var,1,'X'}], 32 | %% [], 33 | %% [{op,1,'+',{var,1,'X'},{integer,1,1}}]}]}} 34 | %% 35 | %%9> element(2,eml:p("fun add1 X = X + 1;")). 36 | %%{function,1,add1,1, 37 | %% [{clause,1, 38 | %% [{var,1,'X'}], 39 | %% [], 40 | %% [{arith,1,'+',{var,1,'X'},{integer,1,1}}]}]} 41 | 42 | 43 | print(Forms) -> 44 | X = erl_prettypr:format(?e:form_list([?e:revert(Forms)]), 45 | [{paper,160},{ribbon,80}]), 46 | io:format("~p~n",[X]). 47 | 48 | 49 | 50 | run(ParseTrees) when is_list(ParseTrees) -> 51 | {ok, [r(ParseTree) || ParseTree <- ParseTrees]}. 52 | 53 | r({function,Line,Name,Arity,Clauses}) -> 54 | put(used_vars, vars(Clauses)), 55 | {function,Line,Name,Arity,[r(C) || C <- Clauses]}; 56 | 57 | r({'fun',Line,{clauses,Clauses}}) -> 58 | {'fun',Line,{clauses,[r(C) || C <- Clauses]}}; 59 | 60 | r({clause,Line,FormalArgs,Guards,Exprs}) -> 61 | {clause,Line,FormalArgs,Guards,[r(E) || E <- Exprs]}; 62 | 63 | r({call,Line,Fun,Args}) -> 64 | {call,Line,Fun,[r(A) || A <- Args]}; 65 | 66 | r({'let',Line,[{val,_Line,FormalArg,ActualArg}|E],Exprs}) -> 67 | %% 68 | %% We transform a let as described in SPJ: 69 | %% 70 | %% (let v1 = B1, v2 = B2 in E) == 71 | %% (let v1 = B1 72 | %% in let v2 = B2 in E) == 73 | %% (let v1 = B1 in E' == ((\v1.E')B1) , E' == (let v2 = B2 in E) 74 | %% 75 | {call,Line, 76 | {'fun',Line, 77 | {clauses, 78 | [{clause,Line,[FormalArg],[], %% r(FormalArg1) ?? 79 | return(r({'let',Line,E,Exprs}))}]}}, 80 | [r(ActualArg)]}; 81 | 82 | r({'let',Line,[{rec,_Line,Var,FunExpr}|E],Exprs}) -> 83 | %% 84 | %% We transform a 'let rec' to a let + the use of the Y combinator 85 | %% as described in SPJ: 86 | %% 87 | %% (let rec v = B in E) == , B= 88 | %% let val Y = 89 | %% in let val v = Y(\v.B) in E) 90 | %% 91 | Yvar = get_non_used_var(), 92 | Arity = arity(FunExpr), 93 | Vs = [y(Line,Yvar,Arity), 94 | {val, Line, Var, 95 | {call, Line, {var,Line,Yvar}, 96 | [{'fun', Line, 97 | {clauses, 98 | [{clause, Line, [Var],[], [FunExpr]}]}}]}} 99 | |E], 100 | r({'let',Line,Vs,Exprs}); 101 | 102 | r({'let',_Line,[],Exprs}) -> 103 | [r(E) || E <- Exprs]; 104 | 105 | 106 | r({'case', Line, Expr, Clauses}) -> 107 | %% 108 | %% We transform case expressions as: 109 | %% 110 | %% (case E of P1 => B1 | P2 => B2 end) == 111 | %% (let v0 = E in (fn P1 = B1 | fn P2 = B2)(v0)) 112 | %% 113 | Var = get_non_used_var(), 114 | R = {'let', Line, 115 | [{val, Line, {var, Line, Var}, Expr}], 116 | [{call, Line, {'fun', Line, {clauses, Clauses}}, [{var, Line, Var}]}]}, 117 | r(R); 118 | 119 | 120 | r({op_fun, Line, Op}) -> 121 | %% 122 | %% Corresponds to '@+' as in: foldl(@+, 0, [1,2,3]) 123 | %% 124 | {'fun',Line, 125 | {clauses, 126 | [{clause,Line, 127 | [{var,Line,'X'},{var,Line,'Y'}], 128 | [], 129 | [{op,Line,Op,{var,Line,'X'},{var,Line,'Y'}}]}]}}; 130 | 131 | 132 | r({range, Line, From, To, By}) -> 133 | %% 134 | %% [From..To by By] == lists:seq(From,To,By) 135 | %% 136 | {call,Line, 137 | {remote,Line,{atom,Line,lists},{atom,Line,seq}}, 138 | [From,To,By]}; 139 | 140 | 141 | r(ParseTree) -> 142 | ParseTree. 143 | 144 | %% Require ('used_vars',VarList) in process dictionary! 145 | get_non_used_var() -> 146 | true = erlang:is_list(get(used_vars)), % assert! 147 | list_to_atom(get_non_used_var("_EML_", 1)). 148 | 149 | get_non_used_var(V,N) when is_list(V), is_integer(N) -> 150 | Var = V ++ integer_to_list(N), 151 | case lists:member(Var, get(used_vars)) of 152 | false -> Var; 153 | true -> get_non_used_var(V,N+1) 154 | end. 155 | 156 | return(List) when is_list(List) -> List; 157 | return(Term) -> [Term]. 158 | 159 | 160 | %% FIXME: Get non-used variables in Var&FunBody 161 | %% Also, only one Y function is required in case of multiple letrec's 162 | %% 163 | %% The Y-combinator: 164 | %% 165 | %% let val Y = 166 | %% fn M => 167 | %% (let val G = fn F => M(fn A => (F(F))(A)) 168 | %% in G(G)) 169 | %% 170 | y(Line,Var, Arity) -> 171 | Vs = [{var,Line,list_to_atom("A"++integer_to_list(I))} 172 | || I <- lists:seq(1,Arity)], 173 | {val,Line, 174 | {var,Line,Var}, 175 | {'fun',Line, 176 | {clauses, 177 | [{clause,Line, 178 | [{var,Line,'M'}], 179 | [], 180 | [{'let',Line, 181 | [{val,Line, 182 | {var,Line,'G'}, 183 | {'fun',Line, 184 | {clauses, 185 | [{clause,Line, 186 | [{var,Line,'F'}], 187 | [], 188 | [{call,Line, 189 | {var,Line,'M'}, 190 | [{'fun',Line, 191 | {clauses, 192 | [{clause,Line,Vs,[], 193 | [{call,Line, 194 | {call,Line,{var,Line,'F'},[{var,Line,'F'}]}, 195 | Vs}]}]}}]}]}]}}}], 196 | [{call,Line,{var,Line,'G'},[{var,Line,'G'}]}]}]}]}}}. 197 | 198 | 199 | %% Compute the arity of an anonymous function 200 | arity({'fun',_,{clauses,[{clause,_,FormalArgs,_,_}|_]}}) -> length(FormalArgs). 201 | 202 | %%% Extract all variables used 203 | vars(R) -> ordsets:to_list(vars(R,ordsets:new())). 204 | 205 | vars({var,_,Var}, Acc) -> [Var|Acc]; 206 | vars(Tuple,Acc) when is_tuple(Tuple) -> 207 | lists:foldl(fun(X,Acc1) -> ordsets:union(vars(X),Acc1) end, 208 | Acc, tuple_to_list(Tuple)); 209 | vars(List,Acc) when is_list(List) -> 210 | lists:foldl(fun(X,Acc1) -> ordsets:union(vars(X),Acc1) end, 211 | Acc, List); 212 | vars(_,Acc) -> 213 | Acc. 214 | 215 | 216 | curry([H|T]) -> c([H]) ++ curry(T); 217 | curry([]) -> []. 218 | 219 | 220 | c([{function,Line,Name,Arity,_Clauses}=H|T]) when Arity > 0 -> 221 | Vs = [{var,Line,l2a("X"++i2l(N))} || N <- lists:seq(1,Arity)], 222 | [Last|RevFirst] = lists:reverse(Vs), 223 | c([{function,Line,Name,Arity-1, 224 | [{clause,Line,lists:reverse(RevFirst),[], 225 | [{'fun',Line, 226 | {clauses, 227 | [{clause,Line, 228 | [Last],[], 229 | [{call,Line,{atom,1,Name},Vs}]}]}}]}]}, 230 | H|T]); 231 | c(L) -> 232 | L. 233 | 234 | l2a(L) when is_list(L) -> list_to_atom(L). 235 | i2l(I) when is_integer(I) -> integer_to_list(I). 236 | 237 | e3(T) -> element(3,T). 238 | e4(T) -> element(4,T). 239 | -------------------------------------------------------------------------------- /src/eml_lexer.xrl: -------------------------------------------------------------------------------- 1 | %%% 2 | %%% Slightly modified by etnt@redhoterlang.com 3 | %%% 4 | %%% File : erlang_scan.xrl 5 | %%% Author : Robert Virding 6 | %%% Purpose : Token definitions for Erlang. 7 | 8 | Definitions. 9 | O = [0-7] 10 | D = [0-9] 11 | H = [0-9a-fA-F] 12 | U = [A-Z] 13 | L = [a-z] 14 | A = ({U}|{L}|{D}|_|@) 15 | WS = ([\000-\s]|%.*) 16 | 17 | Rules. 18 | {D}+\.{D}+((E|e)(\+|\-)?{D}+)? : 19 | {token,{float,TokenLine,list_to_float(TokenChars)}}. 20 | 21 | {D}+#{H}+ : base(TokenLine, TokenChars). 22 | 23 | {D}+ : {token,{integer,TokenLine,list_to_integer(TokenChars)}}. 24 | 25 | {L}{A}* : Atom = list_to_atom(TokenChars), 26 | {token,case reserved_word(Atom) of 27 | true -> {Atom,TokenLine}; 28 | false -> {atom,TokenLine,Atom} 29 | end}. 30 | 31 | '(\\\^.|\\.|[^'])*' : 32 | %% Strip quotes. 33 | S = lists:sublist(TokenChars, 2, TokenLen - 2), 34 | case catch list_to_atom(string_gen(S)) of 35 | {'EXIT',_} -> {error,"illegal atom " ++ TokenChars}; 36 | Atom -> {token,{atom,TokenLine,Atom}} 37 | end. 38 | 39 | ({U}|_){A}* : {token,{var,TokenLine,list_to_atom(TokenChars)}}. 40 | 41 | "(\\\^.|\\.|[^"])*" : 42 | %% Strip quotes. 43 | S = lists:sublist(TokenChars, 2, TokenLen - 2), 44 | {token,{string,TokenLine,string_gen(S)}}. 45 | 46 | \$(\\{O}{O}{O}|\\\^.|\\.|.) : 47 | {token,{char,TokenLine,cc_convert(TokenChars)}}. 48 | 49 | -> : {token,{'->',TokenLine}}. 50 | 51 | :- : {token,{':-',TokenLine}}. 52 | 53 | \|\| : {token,{'||',TokenLine}}. 54 | 55 | <- : {token,{'<-',TokenLine}}. 56 | 57 | \+\+ : {token,{'++',TokenLine}}. 58 | 59 | -- : {token,{'--',TokenLine}}. 60 | 61 | =/= : {token,{'=/=',TokenLine}}. 62 | 63 | == : {token,{'==',TokenLine}}. 64 | 65 | =:= : {token,{'=:=',TokenLine}}. 66 | 67 | /= : {token,{'/=',TokenLine}}. 68 | 69 | >= : {token,{'>=',TokenLine}}. 70 | 71 | =< : {token,{'=<',TokenLine}}. 72 | 73 | <= : {token,{'<=',TokenLine}}. 74 | 75 | => : {token,{'=>',TokenLine}}. 76 | 77 | << : {token,{'<<',TokenLine}}. 78 | 79 | >> : {token,{'>>',TokenLine}}. 80 | 81 | :: : {token,{'::',TokenLine}}. 82 | 83 | \.\. : {token,{'..',TokenLine}}. 84 | 85 | @[\+\-\*/] : {token,{list_to_atom(TokenChars),TokenLine}}. 86 | 87 | []()[}{|!?/;:,.*+#<>=-] : 88 | {token,{list_to_atom(TokenChars),TokenLine}}. 89 | 90 | \.{WS} : {end_token,{dot,TokenLine}}. 91 | 92 | {WS}+ : skip_token. 93 | 94 | Erlang code. 95 | 96 | -export([reserved_word/1]). 97 | 98 | %% reserved_word(Atom) -> Bool 99 | %% return 'true' if Atom is an Erlang reserved word, else 'false'. 100 | 101 | reserved_word('when') -> true; 102 | reserved_word('let') -> true; 103 | reserved_word('val') -> true; 104 | reserved_word('rec') -> true; 105 | reserved_word('in') -> true; 106 | reserved_word('by') -> true; 107 | reserved_word('try') -> true; 108 | reserved_word('catch') -> true; 109 | reserved_word('andalso') -> true; 110 | reserved_word('orelse') -> true; 111 | reserved_word('fun') -> true; 112 | reserved_word('fn') -> true; 113 | reserved_word('case') -> true; 114 | reserved_word('of') -> true; 115 | reserved_word('end') -> true; 116 | reserved_word('bnot') -> true; 117 | reserved_word('not') -> true; 118 | reserved_word('div') -> true; 119 | reserved_word('rem') -> true; 120 | reserved_word('band') -> true; 121 | reserved_word('and') -> true; 122 | reserved_word('bor') -> true; 123 | reserved_word('bxor') -> true; 124 | reserved_word('bsl') -> true; 125 | reserved_word('bsr') -> true; 126 | reserved_word('xor') -> true; 127 | reserved_word(_) -> false. 128 | 129 | base(L, Cs) -> 130 | H = string:chr(Cs, $#), 131 | case list_to_integer(string:substr(Cs, 1, H-1)) of 132 | B when B > 16 -> {error,"illegal base"}; 133 | B -> 134 | case base(string:substr(Cs, H+1), B, 0) of 135 | error -> {error,"illegal based number"}; 136 | N -> {token,{integer,L,N}} 137 | end 138 | end. 139 | 140 | base([C|Cs], Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> 141 | Next = SoFar * Base + (C - $0), 142 | base(Cs, Base, Next); 143 | base([C|Cs], Base, SoFar) when C >= $a, C =< $f, C < Base + $a - 10 -> 144 | Next = SoFar * Base + (C - $a + 10), 145 | base(Cs, Base, Next); 146 | base([C|Cs], Base, SoFar) when C >= $A, C =< $F, C < Base + $A - 10 -> 147 | Next = SoFar * Base + (C - $A + 10), 148 | base(Cs, Base, Next); 149 | base([_|_], _, _) -> error; %Unknown character 150 | base([], _, N) -> N. 151 | 152 | cc_convert([$$,$\\|Cs]) -> 153 | hd(string_escape(Cs)); 154 | cc_convert([$$,C]) -> C. 155 | 156 | string_gen([$\\|Cs]) -> 157 | string_escape(Cs); 158 | string_gen([C|Cs]) -> 159 | [C|string_gen(Cs)]; 160 | string_gen([]) -> []. 161 | 162 | string_escape([O1,O2,O3|S]) when 163 | O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> 164 | [(O1*8 + O2)*8 + O3 - 73*$0|string_gen(S)]; 165 | string_escape([$^,C|Cs]) -> 166 | [C band 31|string_gen(Cs)]; 167 | string_escape([C|Cs]) when C >= $\000, C =< $\s -> 168 | string_gen(Cs); 169 | string_escape([C|Cs]) -> 170 | [escape_char(C)|string_gen(Cs)]. 171 | 172 | escape_char($n) -> $\n; %\n = LF 173 | escape_char($r) -> $\r; %\r = CR 174 | escape_char($t) -> $\t; %\t = TAB 175 | escape_char($v) -> $\v; %\v = VT 176 | escape_char($b) -> $\b; %\b = BS 177 | escape_char($f) -> $\f; %\f = FF 178 | escape_char($e) -> $\e; %\e = ESC 179 | escape_char($s) -> $\s; %\s = SPC 180 | escape_char($d) -> $\d; %\d = DEL 181 | escape_char(C) -> C. 182 | -------------------------------------------------------------------------------- /src/eml_parser.yrl: -------------------------------------------------------------------------------- 1 | %% --------------------------------------------------------------------- 2 | %% 3 | %% Modified: 22 Dec 2011 by etnt@redhoterlang.com 4 | %% 5 | %% --------------------------------------------------------------------- 6 | %% 7 | %% %CopyrightBegin% 8 | %% 9 | %% Copyright Ericsson AB 1996-2009. All Rights Reserved. 10 | %% 11 | %% The contents of this file are subject to the Erlang Public License, 12 | %% Version 1.1, (the "License"); you may not use this file except in 13 | %% compliance with the License. You should have received a copy of the 14 | %% Erlang Public License along with this software. If not, it can be 15 | %% retrieved online at http://www.erlang.org/. 16 | %% 17 | %% Software distributed under the License is distributed on an "AS IS" 18 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 19 | %% the License for the specific language governing rights and limitations 20 | %% under the License. 21 | %% 22 | %% %CopyrightEnd% 23 | %% 24 | Nonterminals 25 | prefix_op add_op comp_op list_op 26 | attribute atomic basic_type bif_test integer_or_var 27 | clause_body 28 | clause_guard clause_head 29 | expr expr_100 expr_150 expr_160 expr_200 expr_300 expr_400 expr_500 30 | expr_600 expr_700 expr_800 expr_900 31 | expr_max expr_tail 32 | exprs farity farity_list 33 | forms form formal_parameter_list argument_list 34 | case_expr cr_clauses cr_clause 35 | function function_call function_clause 36 | fun_expr fun_clauses fun_clause fun_clause_head fun_cr_clause_body 37 | guard guard_call guard_expr 38 | op_fun_expr 39 | let_expr val_exprs val_expr 40 | list_comprehension binary_comprehension 41 | lc_exprs lc_expr binary bin_elements bin_element bit_expr 42 | opt_bit_size_expr opt_bit_type_list bit_type_list bit_type bit_size_expr 43 | guard_expr_list guard_exprs guard_expr_tail guard_expr_tuple 44 | guard_parameter_list 45 | guard_tests guard_test list 46 | %if_clause if_clauses 47 | mult_op 48 | pattern patterns comma_patterns pattern_list pattern_tail pattern_tuple 49 | tuple strings. 50 | 51 | Terminals 52 | '(' ')' '*' '+' ',' '-' '/' '/=' ':' ';' '<' '=' '=/=' '=:=' 53 | '<<' '>>' '<-' '<=' '=<' '==' '>' '>=' '[' ']' '.' 'band' 'bnot' 54 | 'fun' 'val' 'rec' 55 | 'bor' 'bsl' 'bsr' 'bxor' 'div' 'let' 'in' 'fn' '=>' 'by' 56 | 'case' 'of' 57 | '@+' '@-' '@*' '@/' '..' 58 | 'orelse' 'andalso' 'not' 'and' 'or' 'xor' '++' '--' 59 | 'rem' '{' '|' '||' '}' 'when' atom float integer string var. 60 | 61 | 62 | Rootsymbol forms. 63 | 64 | forms -> form : ['$1']. 65 | forms -> form forms : ['$1'|'$2']. 66 | 67 | form -> '-' atom '(' attribute ')' : 68 | {attribute, element(2, '$2'), element(3, '$2'), '$4'}. 69 | form -> function : '$1'. 70 | 71 | 72 | attribute -> atom : element(3, '$1'). 73 | attribute -> '[' farity_list ']' : '$2'. 74 | 75 | farity_list -> farity : ['$1']. 76 | farity_list -> farity ',' farity_list : ['$1' | '$3']. 77 | 78 | farity -> atom '/' integer : {element(3, '$1'), element(3, '$3')}. 79 | 80 | 81 | function -> function_clause ';' : '$1'. 82 | function -> function_clause function : 83 | case '$1' of 84 | {function, Pos1, Name1, Arity1, [Clause]} -> 85 | case '$2' of 86 | {function, _, Name1, Arity2, Clauses} -> 87 | if 88 | Arity1 /= Arity2 -> 89 | throw({error, {Pos1, yecc, 90 | io_lib:format('arity conflict in definition of ~w', 91 | [Name1])}}); 92 | true -> 93 | {function, Pos1, Name1, Arity1, [Clause | Clauses]} 94 | end; 95 | _ -> 96 | throw({error, {Pos1, yecc, 97 | io_lib:format('missing final semicolon in def of ~w/~w', 98 | [Name1, Arity1])}}) 99 | end 100 | end. 101 | 102 | function_clause -> clause_head clause_guard clause_body : 103 | {Name, Line, Arity, Parameters} = '$1', 104 | {function, Line, Name, Arity, 105 | [{clause, element(2, hd('$3')), Parameters, '$2', '$3'}]}. 106 | 107 | clause_head -> 'fun' atom formal_parameter_list : 108 | {element(3, '$2'), element(2, '$2'), length('$3'), '$3'}. 109 | 110 | clause_head -> '|' atom formal_parameter_list : 111 | {element(3, '$2'), element(2, '$2'), length('$3'), '$3'}. 112 | 113 | formal_parameter_list -> patterns : '$1'. 114 | formal_parameter_list -> '$empty' : []. 115 | 116 | clause_guard -> 'when' guard : '$2'. 117 | clause_guard -> '$empty' : []. 118 | 119 | clause_body -> '=' exprs: '$2'. 120 | 121 | patterns -> pattern : ['$1']. 122 | patterns -> pattern patterns : ['$1' | '$2']. 123 | 124 | comma_patterns -> pattern : ['$1']. 125 | comma_patterns -> pattern ',' comma_patterns : ['$1' | '$3']. 126 | 127 | pattern -> basic_type : '$1'. 128 | pattern -> pattern_list : '$1'. 129 | pattern -> pattern_tuple : '$1'. 130 | 131 | pattern_list -> '[' ']' : {nil, ?line('$1')}. 132 | pattern_list -> '[' pattern pattern_tail ']' : 133 | case '$3' of 134 | {nil,0} -> {cons, ?line('$1'), '$2', {nil, ?line('$1')}}; 135 | _ -> {cons, ?line('$1'), '$2', '$3'} 136 | end. 137 | 138 | pattern_tail -> '|' pattern : '$2'. 139 | pattern_tail -> ',' pattern pattern_tail : 140 | case '$3' of 141 | {nil,0} -> {cons, ?line('$2'), '$2', {nil, ?line('$2')}}; 142 | _ -> {cons, ?line('$2'), '$2', '$3'} 143 | end. 144 | pattern_tail -> '$empty' : {nil,0}. 145 | 146 | pattern_tuple -> '{' '}' : {tuple, element(2, '$1'), []}. 147 | pattern_tuple -> '{' comma_patterns '}' : {tuple, element(2, '$1'), '$2'}. 148 | 149 | 150 | exprs -> expr : ['$1']. 151 | exprs -> expr ',' exprs : ['$1' | '$3']. 152 | 153 | expr -> expr_100 : '$1'. 154 | 155 | % No Erlang match expressions are allowed. Use 'let' instead! 156 | %expr_100 -> expr_150 '=' expr_100 : {match,?line('$2'),'$1','$3'}. 157 | %expr_100 -> expr_150 '!' expr_100 : ?mkop2('$1', '$2', '$3'). 158 | expr_100 -> expr_150 : '$1'. 159 | 160 | expr_150 -> expr_160 'orelse' expr_150 : ?mkop2('$1', '$2', '$3'). 161 | expr_150 -> expr_160 : '$1'. 162 | 163 | expr_160 -> expr_200 'andalso' expr_160 : ?mkop2('$1', '$2', '$3'). 164 | expr_160 -> expr_200 : '$1'. 165 | 166 | expr_200 -> expr_300 comp_op expr_300 : 167 | ?mkop2('$1', '$2', '$3'). 168 | expr_200 -> expr_300 : '$1'. 169 | 170 | expr_300 -> expr_400 list_op expr_300 : 171 | ?mkop2('$1', '$2', '$3'). 172 | expr_300 -> expr_400 : '$1'. 173 | 174 | expr_400 -> expr_400 add_op expr_500 : 175 | ?mkop2('$1', '$2', '$3'). 176 | expr_400 -> expr_500 : '$1'. 177 | 178 | expr_500 -> expr_500 mult_op expr_600 : 179 | ?mkop2('$1', '$2', '$3'). 180 | expr_500 -> expr_600 : '$1'. 181 | 182 | expr_600 -> prefix_op expr_700 : 183 | ?mkop1('$1', '$2'). 184 | expr_600 -> expr_700 : '$1'. 185 | 186 | expr_700 -> function_call : '$1'. 187 | %%expr_700 -> record_expr : '$1'. 188 | expr_700 -> expr_800 : '$1'. 189 | 190 | expr_800 -> expr_900 ':' expr_max : 191 | {remote,?line('$2'),'$1','$3'}. 192 | expr_800 -> expr_900 : '$1'. 193 | 194 | expr_900 -> '.' atom : 195 | {record_field,?line('$1'),{atom,?line('$1'),''},'$2'}. 196 | expr_900 -> expr_900 '.' atom : 197 | {record_field,?line('$2'),'$1','$3'}. 198 | expr_900 -> expr_max : '$1'. 199 | 200 | expr_max -> basic_type : '$1'. 201 | expr_max -> list : '$1'. 202 | expr_max -> binary : '$1'. 203 | expr_max -> list_comprehension : '$1'. 204 | expr_max -> binary_comprehension : '$1'. 205 | expr_max -> tuple : '$1'. 206 | %%expr_max -> struct : '$1'. 207 | expr_max -> '(' expr ')' : '$2'. 208 | %%expr_max -> 'begin' exprs 'end' : {block,?line('$1'),'$2'}. 209 | %%expr_max -> if_expr : '$1'. 210 | expr_max -> case_expr : '$1'. 211 | %%expr_max -> receive_expr : '$1'. 212 | expr_max -> op_fun_expr : '$1'. 213 | expr_max -> fun_expr : '$1'. 214 | %%expr_max -> try_expr : '$1'. 215 | %%expr_max -> query_expr : '$1'. 216 | expr_max -> let_expr : '$1'. 217 | 218 | basic_type -> atomic : '$1'. 219 | basic_type -> var : '$1'. 220 | 221 | list -> '[' ']' : {nil, ?line('$1')}. 222 | list -> '[' integer_or_var '..' integer_or_var ']' : 223 | {range, ?line('$1'), '$2', '$4', {integer,?line('$1'),1}}. 224 | list -> '[' integer_or_var '..' integer_or_var 'by' integer_or_var ']': 225 | {range, ?line('$1'), '$2', '$4', '$6'}. 226 | list -> '[' expr expr_tail ']' : 227 | case '$3' of 228 | {nil,0} -> {cons, ?line('$1'), '$2', {nil, ?line('$1')}}; 229 | _ -> {cons, ?line('$1'), '$2', '$3'} 230 | end. 231 | 232 | integer_or_var -> integer : '$1'. 233 | integer_or_var -> var : '$1'. 234 | 235 | expr_tail -> '|' expr : '$2'. 236 | expr_tail -> ',' expr expr_tail : 237 | case '$3' of 238 | {nil,0} -> {cons, ?line('$2'), '$2', {nil, ?line('$2')}}; 239 | _ -> {cons, ?line('$2'), '$2', '$3'} 240 | end. 241 | expr_tail -> '$empty' : {nil,0}. 242 | 243 | tuple -> '{' '}' : {tuple, ?line('$1'), []}. 244 | tuple -> '{' exprs '}' : {tuple, ?line('$1'), '$2'}. 245 | 246 | %% ----------------------------------------------------------------- 247 | %% CASE EXPRESSION 248 | %% --------------- 249 | %% 250 | %% case Expr of 251 | %% Pat1 => Body1 252 | %% | Pat2 => Body2 253 | %% 254 | %% ----------------------------------------------------------------- 255 | case_expr -> 'case' expr 'of' cr_clauses : 256 | {'case',?line('$1'),'$2','$4'}. 257 | 258 | cr_clauses -> cr_clause : ['$1']. 259 | cr_clauses -> cr_clause '|' cr_clauses : ['$1' | '$3']. 260 | 261 | cr_clause -> formal_parameter_list clause_guard fun_cr_clause_body : 262 | {clause,?line(hd('$1')),'$1','$2','$3'}. 263 | 264 | 265 | %% ----------------------------------------------------------------- 266 | %% OP FUN EXPRESSION 267 | %% --------------- 268 | %% 269 | %% @ , where ::= + | + | * | / 270 | %% 271 | %% ----------------------------------------------------------------- 272 | op_fun_expr -> '@+' : {op_fun, ?line('$1'), '+'}. 273 | op_fun_expr -> '@-' : {op_fun, ?line('$1'), '-'}. 274 | op_fun_expr -> '@*' : {op_fun, ?line('$1'), '*'}. 275 | op_fun_expr -> '@/' : {op_fun, ?line('$1'), '/'}. 276 | 277 | %% ----------------------------------------------------------------- 278 | %% FUN EXPRESSION 279 | %% --------------- 280 | %% 281 | %% fn Pat1 => Body 282 | %% | fn Pat2 => Body2 283 | %% 284 | %% ----------------------------------------------------------------- 285 | fun_expr -> fun_clauses : build_fun('$1'). 286 | 287 | fun_clauses -> fun_clause : ['$1']. 288 | fun_clauses -> fun_clause '|' fun_clauses : ['$1'|'$3']. 289 | 290 | fun_clause -> fun_clause_head clause_guard fun_cr_clause_body : 291 | {'fn', Line, Parameters} = '$1', 292 | {clause, Line, 'fun', Parameters, '$2', '$3'}. 293 | 294 | fun_clause_head -> 'fn' formal_parameter_list : 295 | {'fn', ?line('$1'), '$2'}. 296 | 297 | fun_cr_clause_body -> '=>' exprs : '$2'. 298 | 299 | 300 | function_call -> expr_800 argument_list : 301 | {call,?line('$1'),'$1', element(1,'$2')}. 302 | 303 | argument_list -> '(' ')' : {[],?line('$1')}. 304 | argument_list -> '(' exprs ')' : {'$2',?line('$1')}. 305 | 306 | 307 | %if_expr -> 'if' if_clauses 'end' : {'if', element(2, '$1'), '$2'}. 308 | %if_expr -> 'if' if_clauses : {'if', element(2, '$1'), '$2'}. 309 | 310 | %if_clause -> guard clause_body : {clause, element(2, hd('$2')), '$1', '$2'}. 311 | 312 | %if_clauses -> if_clause : ['$1']. 313 | %if_clauses -> if_clause ';' if_clauses : ['$1' | '$3']. 314 | 315 | 316 | let_expr -> 'let' val_exprs 'in' exprs : 317 | {'let', ?line('$1'), '$2', '$4'}. 318 | 319 | val_exprs -> val_expr : ['$1']. 320 | val_exprs -> val_expr val_exprs : ['$1' | '$2']. 321 | 322 | val_expr -> 'val' pattern '=' expr : {'val', ?line('$1'), '$2', '$4'}. 323 | val_expr -> 'rec' var '=' fun_expr : {'rec', ?line('$1'), '$2', '$4'}. 324 | 325 | 326 | 327 | list_comprehension -> '[' expr '||' lc_exprs ']' : 328 | {lc,?line('$1'),'$2','$4'}. 329 | binary_comprehension -> '<<' binary '||' lc_exprs '>>' : 330 | {bc,?line('$1'),'$2','$4'}. 331 | lc_exprs -> lc_expr : ['$1']. 332 | lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. 333 | 334 | lc_expr -> expr : '$1'. 335 | lc_expr -> expr '<-' expr : {generate,?line('$2'),'$1','$3'}. 336 | lc_expr -> binary '<=' expr : {b_generate,?line('$2'),'$1','$3'}. 337 | 338 | binary -> '<<' '>>' : {bin,?line('$1'),[]}. 339 | binary -> '<<' bin_elements '>>' : {bin,?line('$1'),'$2'}. 340 | 341 | bin_elements -> bin_element : ['$1']. 342 | bin_elements -> bin_element ',' bin_elements : ['$1'|'$3']. 343 | 344 | bin_element -> bit_expr opt_bit_size_expr opt_bit_type_list : 345 | {bin_element,?line('$1'),'$1','$2','$3'}. 346 | 347 | bit_expr -> prefix_op expr_max : ?mkop1('$1', '$2'). 348 | bit_expr -> expr_max : '$1'. 349 | 350 | opt_bit_size_expr -> ':' bit_size_expr : '$2'. 351 | opt_bit_size_expr -> '$empty' : default. 352 | 353 | opt_bit_type_list -> '/' bit_type_list : '$2'. 354 | opt_bit_type_list -> '$empty' : default. 355 | 356 | bit_type_list -> bit_type '-' bit_type_list : ['$1' | '$3']. 357 | bit_type_list -> bit_type : ['$1']. 358 | 359 | bit_type -> atom : element(3,'$1'). 360 | bit_type -> atom ':' integer : { element(3,'$1'), element(3,'$3') }. 361 | 362 | bit_size_expr -> expr_max : '$1'. 363 | 364 | 365 | guard_expr -> basic_type : '$1'. 366 | guard_expr -> guard_expr_list : '$1'. 367 | guard_expr -> guard_expr_tuple : '$1'. 368 | guard_expr -> guard_call : '$1'. 369 | guard_expr -> '(' guard_expr ')' : '$2'. 370 | guard_expr -> guard_expr add_op guard_expr : 371 | {Op, Pos} = '$2', 372 | {arith, Pos, Op, '$1', '$3'}. 373 | guard_expr -> guard_expr mult_op guard_expr : 374 | {Op, Pos} = '$2', 375 | {arith, Pos, Op, '$1', '$3'}. 376 | guard_expr -> prefix_op guard_expr: 377 | case '$2' of 378 | {float, Pos, N} -> 379 | case '$1' of 380 | {'-', _} -> 381 | {float, Pos, -N}; 382 | {'+', _} -> 383 | {float, Pos, N}; 384 | {Op, Pos1} -> 385 | {arith, Pos1, Op, {float, Pos, N}} 386 | end; 387 | {integer, Pos, N} -> 388 | case '$1' of 389 | {'-', _} -> 390 | {integer, Pos, -N}; 391 | {'+', _} -> 392 | {integer, Pos, N}; 393 | {Op, Pos1} -> 394 | {arith, Pos1, Op, {integer, Pos, N}} 395 | end; 396 | _ -> 397 | {Op, Pos} = '$1', 398 | {arith, Pos, Op, '$2'} 399 | end. 400 | 401 | guard_expr_list -> '[' ']' : {nil, ?line('$1')}. 402 | guard_expr_list -> '[' guard_expr guard_expr_tail ']' : 403 | {cons, ?line('$1'), '$2', '$3'}. 404 | 405 | guard_expr_tail -> '|' guard_expr : '$2'. 406 | guard_expr_tail -> ',' guard_expr guard_expr_tail : 407 | case '$3' of 408 | {nil,0} -> {cons, ?line('$2'), '$2', {nil, ?line('$2')}}; 409 | _ -> {cons, ?line('$2'), '$2', '$3'} 410 | end. 411 | guard_expr_tail -> '$empty' : {nil,0}. 412 | 413 | guard_expr_tuple -> '{' '}' : {tuple, element(2, '$1'), []}. 414 | guard_expr_tuple -> '{' guard_exprs '}' : {tuple, element(2, '$1'), '$2'}. 415 | 416 | guard_exprs -> guard_expr : ['$1']. 417 | guard_exprs -> guard_expr ',' guard_exprs : ['$1' | '$3']. 418 | 419 | 420 | guard_call -> atom '(' guard_parameter_list ')' : 421 | case erl_parse:erlang_guard_bif(element(3, '$1'), length('$3')) of 422 | true -> 423 | {bif, element(2, '$1'), element(3, '$1'), '$3'}; 424 | false -> 425 | throw({error, {element(2, '$1'), yecc, "illegal test in guard **"}}) 426 | end. 427 | 428 | guard_parameter_list -> guard_exprs : '$1'. 429 | guard_parameter_list -> '$empty' : []. 430 | 431 | 432 | bif_test -> atom '(' guard_parameter_list ')' : 433 | case erl_parse:erlang_guard_test(element(3, '$1'), length('$3')) of 434 | true -> 435 | {test, element(2, '$1'), element(3, '$1'), '$3'}; 436 | false -> 437 | throw({error, {element(2, '$1'), yecc, "illegal test in guard **"}}) 438 | end. 439 | 440 | 441 | guard_test -> bif_test : '$1'. 442 | guard_test -> guard_expr comp_op guard_expr : 443 | {Op, Pos} = '$2', 444 | {comp, Pos, Op, '$1', '$3'}. 445 | 446 | guard_tests -> guard_test : ['$1']. 447 | guard_tests -> guard_test ',' guard_tests : ['$1' | '$3']. 448 | 449 | % guard -> 'true' : []. 450 | guard -> atom : 451 | case '$1' of 452 | {atom, _, true} -> 453 | []; 454 | _ -> 455 | throw({error, {element(2, '$1'), yecc, "illegal test in guard **"}}) 456 | end. 457 | guard -> guard_tests : '$1'. 458 | 459 | 460 | 461 | %%atomic -> char : '$1'. 462 | atomic -> integer : '$1'. 463 | atomic -> float : '$1'. 464 | atomic -> atom : '$1'. 465 | atomic -> strings : '$1'. 466 | 467 | strings -> string : '$1'. 468 | strings -> string strings : 469 | {string,?line('$1'),element(3, '$1') ++ element(3, '$2')}. 470 | 471 | 472 | prefix_op -> '+' : '$1'. 473 | prefix_op -> '-' : '$1'. 474 | prefix_op -> 'bnot' : '$1'. 475 | prefix_op -> 'not' : '$1'. 476 | 477 | mult_op -> '/' : '$1'. 478 | mult_op -> '*' : '$1'. 479 | mult_op -> 'div' : '$1'. 480 | mult_op -> 'rem' : '$1'. 481 | mult_op -> 'band' : '$1'. 482 | mult_op -> 'and' : '$1'. 483 | 484 | add_op -> '+' : '$1'. 485 | add_op -> '-' : '$1'. 486 | add_op -> 'bor' : '$1'. 487 | add_op -> 'bxor' : '$1'. 488 | add_op -> 'bsl' : '$1'. 489 | add_op -> 'bsr' : '$1'. 490 | add_op -> 'or' : '$1'. 491 | add_op -> 'xor' : '$1'. 492 | 493 | list_op -> '++' : '$1'. 494 | list_op -> '--' : '$1'. 495 | 496 | comp_op -> '==' : '$1'. 497 | comp_op -> '/=' : '$1'. 498 | comp_op -> '=<' : '$1'. 499 | comp_op -> '<' : '$1'. 500 | comp_op -> '>=' : '$1'. 501 | comp_op -> '>' : '$1'. 502 | comp_op -> '=:=' : '$1'. 503 | comp_op -> '=/=' : '$1'. 504 | 505 | 506 | Erlang code. 507 | 508 | %% mkop(Op, Arg) -> {op,Line,Op,Arg}. 509 | %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. 510 | 511 | -define(mkop2(L, OpPos, R), 512 | begin 513 | {Op,Pos} = OpPos, 514 | {op,Pos,Op,L,R} 515 | end). 516 | 517 | -define(mkop1(OpPos, A), 518 | begin 519 | {Op,Pos} = OpPos, 520 | {op,Pos,Op,A} 521 | end). 522 | 523 | %% keep track of line info in tokens 524 | -define(line(Tup), element(2, Tup)). 525 | 526 | %% build_fun(Line, [Clause]) -> {'fun',Line,{clauses,[Clause]}}. 527 | build_fun([H|_] = Cs) -> 528 | Arity = length(element(4, hd(Cs))), 529 | {'fun',?line(H),{clauses,check_clauses(Cs, 'fun', Arity)}}. 530 | 531 | check_clauses(Cs, Name, Arity) -> 532 | mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity -> 533 | {clause,L,As,G,B}; 534 | ({clause,L,_N,_As,_G,_B}) -> 535 | ret_err(L, "head mismatch") end, Cs). 536 | 537 | %% mapl(F,List) 538 | %% an alternative map which always maps from left to right 539 | %% and makes it possible to interrupt the mapping with throw on 540 | %% the first occurence from left as expected. 541 | %% can be removed when the jam machine (and all other machines) 542 | %% uses the standardized (Erlang 5.0) evaluation order (from left to right) 543 | mapl(F, [H|T]) -> 544 | V = F(H), 545 | [V | mapl(F,T)]; 546 | mapl(_, []) -> 547 | []. 548 | 549 | -spec ret_err(_, _) -> no_return(). 550 | ret_err(L, S) -> 551 | {location,Location} = get_attribute(L, location), 552 | return_error(Location, S). 553 | 554 | %%% [Experimental]. The parser just copies the attributes of the 555 | %%% scanner tokens to the abstract format. This design decision has 556 | %%% been hidden to some extent: use set_line() and get_attribute() to 557 | %%% access the second element of (almost all) of the abstract format 558 | %%% tuples. A typical use is to negate line numbers to prevent the 559 | %%% compiler from emitting warnings and errors. The second element can 560 | %%% (of course) be set to any value, but then these functions no 561 | %%% longer apply. To get all present attributes as a property list 562 | %%% get_attributes() should be used. 563 | 564 | set_line(L, F) -> 565 | erl_scan:set_attribute(line, L, F). 566 | 567 | get_attribute(L, Name) -> 568 | erl_scan:attributes_info(L, Name). 569 | 570 | get_attributes(L) -> 571 | erl_scan:attributes_info(L). 572 | -------------------------------------------------------------------------------- /src/rebar_eml_plugin.erl: -------------------------------------------------------------------------------- 1 | %% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %% ex: ts=4 sw=4 et 3 | %% ------------------------------------------------------------------- 4 | %% 5 | %% Copyright (c) 2012 Torbjorn Tornkvist (etnt@redhoterlang.com) 6 | %% 7 | %% This file is based upon rebar_lfe_compiler.erl from the 8 | %% Rebar project, which had the following notice: 9 | %% 10 | %% Copyright (c) 2009 Dave Smith (dizzyd@dizzyd.com), 11 | %% Tim Dysinger (tim@dysinger.net) 12 | %% 13 | %% Permission is hereby granted, free of charge, to any person obtaining a copy 14 | %% of this software and associated documentation files (the "Software"), to deal 15 | %% in the Software without restriction, including without limitation the rights 16 | %% to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 17 | %% copies of the Software, and to permit persons to whom the Software is 18 | %% furnished to do so, subject to the following conditions: 19 | %% 20 | %% The above copyright notice and this permission notice shall be included in 21 | %% all copies or substantial portions of the Software. 22 | %% 23 | %% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 24 | %% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 25 | %% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 26 | %% AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 27 | %% LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 28 | %% OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 29 | %% THE SOFTWARE. 30 | %% ------------------------------------------------------------------- 31 | 32 | -module(rebar_eml_plugin). 33 | 34 | -export([compile/2]). 35 | 36 | 37 | %% =================================================================== 38 | %% Public API 39 | %% =================================================================== 40 | 41 | compile(Config, _AppFile) -> 42 | FirstFiles = rebar_config:get_list(Config, lfe_first_files, []), 43 | rebar_base_compiler:run(Config, FirstFiles, "src", ".eml", "ebin", ".beam", 44 | fun compile_eml/3). 45 | 46 | %% =================================================================== 47 | %% Internal functions 48 | %% =================================================================== 49 | 50 | compile_eml(Source, _Target, Config) -> 51 | case code:which(eml) of 52 | non_existing -> 53 | rebar_utils:abort( 54 | "~n" 55 | "*** MISSING EML COMPILER ***~n" 56 | " You must do one of the following:~n" 57 | " a) Install EML globally in your erl libs~n" 58 | " b) Add EML as a dep for your project, eg:~n" 59 | " {eml, \"0.*\",~n" 60 | " {git, \"git://github.com/etnt/eml\",~n" 61 | " \"HEAD\"}}~n" 62 | "~n" 63 | , []); 64 | _ -> 65 | Opts = [{i, "include"}, {outdir, "ebin"}, report] 66 | ++ rebar_config:get_list(Config, erl_opts, []), 67 | try {ok,_} = eml:compile_file(Source, Opts), ok 68 | catch Class:Error -> 69 | rebar_utils:abort("~p: EML compilation failed: ~p:~p~n~p~n", 70 | [Source, Class, Error, erlang:get_stacktrace()]) 71 | end 72 | end. 73 | --------------------------------------------------------------------------------