Init commit

.gitignore

@@ -0,0 +1,11 @@
+.eunit/
+deps/
+src/eml_lexer.erl
+src/eml_parser.erl
+*~
+ebin/*.beam
+ebin/*.app
+examples/*.erl
+examples/*.beam
+examples/*.compile
+examples/*.parse

Makefile

@@ -0,0 +1,43 @@
+SHELL=/bin/bash
+ERL ?= erl
+APP := eml
+
+.PHONY: deps
+
+all: deps
+	@./rebar compile
+
+deps:
+	@./rebar get-deps
+
+examples: all
+	@erl -pa ./ebin -noshell -s eml compile_examples -s init stop
+	@(cd examples; erlc *.erl)
+
+clean:
+	@./rebar clean
+	@rm -f examples/*.erl examples/*.beam
+
+distclean: clean
+	@./rebar delete-deps
+
+test: local_clean
+	@./rebar eunit
+
+ct: all
+	@./rebar -C rebar.config.test ct
+
+ct2: all
+	@./rebar -C rebar.config.test ct
+
+ctv: all
+	@./rebar -C rebar.config.test ct verbose=1
+
+local_clean:
+	@rm -f ./ebin/* .eunit/*
+
+xref: all
+	@./rebar xref
+
+docs:
+	@erl -noshell -run edoc_run application '$(APP)' '"."' '[]'

examples/add.eml

@@ -0,0 +1 @@
+fun add X Y = X + Y;

examples/anon.eml

@@ -0,0 +1,10 @@
+fun double L =
+  let val Mult2 = fn X => X * 2
+  in  map(Mult2,L);
+
+fun map F [H|T] =
+  let val Hd = F(H)
+      val Tl = map(F,T)
+  in
+    [Hd|Tl]
+ | map _ [] = [];

examples/case.eml

@@ -0,0 +1,4 @@
+fun is_even X =
+  case X rem 2 of
+    0 => true
+  | _ => false;

examples/let.eml

@@ -0,0 +1,6 @@
+
+fun split X =
+  let val Even = [Y || Y <- X, (Y rem 2) ==  0]
+      val Odd  = [Y || Y <- X, (Y rem 2) =/= 0]
+  in 
+      {Even,Odd};

examples/let2.eml

@@ -0,0 +1,4 @@
+fun foo X Y =
+  let val Z = X + Y + 4
+      val W = X - Y
+  in {Z,W};

examples/let3.eml

@@ -0,0 +1,5 @@
+fun foo X =
+  let val Z = X + 1
+      val Y = Z + X + 1
+  in Y;
+

examples/letrec.eml

@@ -0,0 +1,4 @@
+fun foo L =
+  let rec Len = fn [] => 0 | fn [_|T] => 1 + Len(T)
+  in Len(L);
+

examples/letrec2.eml

@@ -0,0 +1,6 @@
+fun foo =
+  let val X = [1,2,3]
+      val Y = [a,b,c]
+      rec Zip = fn [] [] => [] | fn [A|B] [H|T] => [{A,H} | Zip(B,T)]
+  in Zip(X,Y);
+

examples/qsort.eml

@@ -0,0 +1,6 @@
+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 [] = [];

rebar.config

@@ -0,0 +1,16 @@
+%%-*- mode: erlang -*-
+
+{deps_dir, ["deps"]}.
+
+{deps, [
+        {eper, "0.*", 
+         {git, "git://github.com/massemanet/eper.git", 
+          "HEAD"}}
+       ]}.
+
+%% Erlang compiler options
+%{erl_opts, [{i, "include"}]}.
+
+%% Add this to a projects rebar.config which is using eml
+%{plugins, [ rebar_eml_plugin ]}.
+%{plugin_dir, "deps/rebar_eml_plugin/src"}.

src/eml.app.src

@@ -0,0 +1,5 @@
+{application, eml, [
+  {description, "Erlang flavored by some ML."},
+  {vsn, "0.1.0"},
+  {env, []}
+]}.

src/eml.erl

@@ -0,0 +1,209 @@
+%% -------------------------------------------------------------------
+%% Created: 22 Dec 2011 by etnt@redhoterlang.com
+%%
+%% @doc Erlang flavoured by Some ML
+%%
+%% -------------------------------------------------------------------
+-module(eml).
+
+-export([c/1
+         , compiler/1
+	 , compile_examples/0
+	 , compile_file/1
+	 , compile_file/2
+         , e/1
+         , f/1
+         , l/1
+         , lexer/1
+         , p/1
+         , parse/1
+         , parser/1
+         , typecheck/1
+        ]).
+
+-include("eml.hrl").
+-include_lib("eunit/include/eunit.hrl").
+
+compile_examples() ->
+    Files = string:tokens(os:cmd("ls examples/*.eml"), "\n"),
+    F = fun(File) ->
+		{ok,_} = compile_file(File),
+		io:format("Compiled file ~s~n",[File])
+	end,
+    [F(File) || File <- Files].
+
+compile_file(FileName) ->
+    compile_file(FileName, []).
+
+compile_file(FileName, Opts) ->
+    ModName = filename:basename(FileName,".eml"),
+    DirName = filename:dirname(FileName),
+    {ok,EmlForms} = parse(FileName),
+    dump(FileName++".parse", EmlForms, Opts),
+    CurryForms = eml_compile:curry(EmlForms),
+    {ok,ErlForms} = compiler(CurryForms),
+    dump(FileName++".compile", ErlForms, Opts),
+    String = to_erl(ModName,ErlForms),
+    file:write_file(filename:join([DirName,ModName++".erl"]),
+		    list_to_binary(String)),
+    compile:file(filename:join([DirName,ModName]), Opts ++ [{outdir,DirName}]).
+
+to_erl(Module,Forms) when is_list(Module) ->
+    Mx = erl_syntax:attribute(erl_syntax:atom("module"),
+			      [erl_syntax:atom(Module)]),
+
+    Es = [erl_syntax:arity_qualifier(
+	    erl_syntax:atom(FunName),
+	    erl_syntax:integer(Arity))
+	  || {function,_,FunName,Arity,_} <- Forms],
+
+    Ex = erl_syntax:attribute(
+	   erl_syntax:atom("export"),
+	   [erl_syntax:list(Es)]),
+
+    erl_prettypr:format(erl_syntax:form_list([Mx,Ex]++Forms)).
+
+
+dump(FileName, Data, Opts) ->
+    case lists:keyfind(verbose,1,Opts) of
+        {verbose,true} ->
+            {ok,Fd} = file:open(FileName, write),
+            io:format(Fd, "~p~n", [Data]),
+            file:close(Fd);
+        _ ->
+            false
+    end.
+
+
+f(FileName) -> 
+    {ok,Forms} = parse(FileName),
+    eml_compile:curry(Forms).
+
+c(S) -> e2(compiler(e2(parser(e2(lexer(S)))))).
+e(S) -> eml_compile:erl_form(S).
+p(S) -> parser(e2(lexer(S))).
+l(S) -> lexer(S).
+
+
+lexer(String) when is_list(String) ->
+    eml_lexer:string(String).
+
+parser(Tokens) when is_list(Tokens) ->
+    eml_parser:parse(Tokens).
+
+typecheck(ParseTree) ->
+    eml_typecheck:run(ParseTree).
+
+compiler(ParseTree) ->
+    eml_compile:run(ParseTree).
+
+
+parse(FileName) ->
+    {ok, InFile} = file:open(FileName, [read]),
+    Acc = loop(InFile,[]),
+    file:close(InFile),
+    eml_parser:parse(Acc).
+
+loop(InFile,Acc) ->
+    case io:request(InFile,{get_until,prompt,eml_lexer,token,[1]}) of
+        {ok,Token,_EndLine} ->
+            loop(InFile,Acc ++ [Token]);
+        {error,token} ->
+            exit(scanning_error);    
+        {eof,_} ->
+            Acc
+    end.
+
+
+
+-ifdef(EUNIT).
+
+compiler_test_() ->
+    [
+     ?_assertEqual([e("add1(X) -> X + 1.")],
+                   c("fun add1 X = X + 1;"))
+
+     ,?_assertEqual([e("len([H|T]) -> 1 + len(T);\nlen([]) -> 0.")],
+                    c("fun len [H|T] = 1 + len(T)\n| len [] = 0;"))
+
+     ,?_assertEqual([e("add3(Y) -> fun (X) -> X + Y end(3).")],
+                    c("fun add3 Y = let val X = 3 in X + Y;"))
+
+     ,?_assertEqual([e("expr(Y) -> ((fun (X) -> fun (Z) -> X*Y+Z end end)(2))(1).")],
+                    c("fun expr Y = let val X = 2 val Z = 1 in X*Y+Z;"))
+
+     ,?_assertEqual([e("add(Y) -> (fun ({X,Z}) -> X + Z end)(Y).")],
+                    c("fun add Y = let val {X,Z} = Y in X + Z;"))
+
+     ,?_assertEqual([e("add(X,Y) -> X + Y.")],
+                    c("fun add X Y = X + Y;"))
+
+     ,?_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([]) -> [].")],
+                    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 [] = [];"))
+
+     ,?_assertEqual([eml:e("add(X) -> fun(Y) -> X + Y end.")],
+                    eml:c("fun add X = fn Y => X + Y;"))
+
+
+    ].
+
+
+parser_test_() ->
+    [
+
+
+%     ?_assertMatch({ok,
+%                    {function,1,len,1,
+%                     [{clause,1,
+%                       [{cons,1,{var,1,'H'},{var,1,'T'}}],
+%                       [],
+%                       [{op,1,'+',
+%                         {integer,1,1},
+%                         {call,1,[],len,[{var,1,'T'}]}}]},
+%                      {clause,2,[{nil,2}],[],[{integer,2,0}]}]}},
+%
+%                   p("fun len [H|T] = 1 + len T\n| len [] = 0;"))
+
+
+%     ,?_assertMatch({ok,{function,1,add,1,
+%                         [{clause,2,
+%                           [{var,1,'X'}],
+%                           [],
+%                           [{'let',2,
+%                             [{val,2,{var,2,'Y'},{integer,2,2}}],
+%                             [{op,2,'+',
+%                               {var,2,'X'},
+%                               {var,2,'Y'}}]}]}]}},
+%
+%                    p("fun add X =\n let val Y = 2 in X + Y;"))
+
+    ].
+
+lexer_test_() ->
+    [
+     ?_assertMatch({ok,[{atom,1,len},
+                        {'[',1},
+                        {atom,1,h},
+                        {'|',1},
+                        {atom,1,t},
+                        {']',1},
+                        {'=',1},
+                        {integer,1,1},
+                        {'+',1},
+                        {atom,1,len},
+                        {atom,1,t},
+                        {atom,2,len},
+                        {'[',2},
+                        {']',2},
+                        {'=',2},
+                        {integer,2,0}],
+                    2},
+                   lexer("len [h|t] = 1 + len t\nlen [] = 0"))
+
+
+    ].
+
+e2(T) when is_tuple(T) -> element(2, T).
+
+
+-endif.