Include Merl in Syntax Tools

8 files changed, 789 insertions, 0 deletions

diff --git a/lib/syntax_tools/examples/merl/Makefile b/lib/syntax_tools/examples/merl/Makefile
new file mode 100644
index 0000000000..13a9703733
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/Makefile
@@ -0,0 +1,22 @@
+EBIN=../../ebin
+INCLUDES=../../include
+SOURCES=merl_build.erl lisp.erl lispc.erl basic.erl basicc.erl
+HEADERS=$(INCLUDES)/merl.hrl
+OBJECTS=$(SOURCES:%.erl=%.beam)
+ERLC_FLAGS=+debug_info -I$(INCLUDES) -pa $(EBIN)
+
+all: $(OBJECTS) test
+
+%.beam: %.erl $(HEADERS) Makefile
+	erlc $(ERLC_FLAGS) -o ./ $<
+
+# additional dependencies due to the parse transform
+lispc.beam basicc.beam: $(EBIN)/merl_transform.beam $(EBIN)/merl.beam
+
+clean:
+	-rm -f $(OBJECTS)
+
+test:
+	erl -noshell -pa $(EBIN) \
+	 -eval 'eunit:test([lisp, lispc, basic, basicc],[])' \
+	 -s init stop
diff --git a/lib/syntax_tools/examples/merl/basic.erl b/lib/syntax_tools/examples/merl/basic.erl
new file mode 100644
index 0000000000..9030059d11
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/basic.erl
@@ -0,0 +1,77 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Trivial Basic interpreter in Erlang
+
+-module(basic).
+
+-export([run/2]).
+
+-include_lib("eunit/include/eunit.hrl").
+
+-define(INTERPRETED, true).
+-include("basic_test.erl").
+
+run(N, Prog) ->
+    ets:new(var, [private, named_table]),
+    ets:new(line, [private, named_table, ordered_set]),
+    lists:foreach(fun (T) -> ets:insert(line, T) end, Prog),
+    goto(N).
+
+stop(N) ->
+    ets:delete(var),
+    ets:delete(line),
+    N.
+
+goto('$end_of_table') -> stop(0);
+goto(L) ->
+    L1 = ets:next(line, L),
+    %% user-supplied line numbers might not exist
+    case ets:lookup(line, L) of
+        [{_, X}] ->
+            stmt(X, L1);
+        _ ->
+            goto(L1)
+    end.
+
+stmt({print, S, As}, L) -> io:format(S, [expr(A) || A <- As]), goto(L);
+stmt({set, V, X}, L) -> ets:insert(var, {V, expr(X)}), goto(L);
+stmt({goto, X}, _L) -> goto(expr(X));
+stmt({stop, X}, _L) -> stop(expr(X));
+stmt({iff, X, A, B}, _L) ->
+    case expr(X) of
+        0 -> goto(B);
+        _ -> goto(A)
+    end.
+
+expr(X) when is_number(X) ; is_list(X) ->
+    X;
+expr(X) when is_atom(X) ->
+    case ets:lookup(var, X) of
+        [] -> 0;
+        [{_,V}] -> V
+    end;
+expr({plus, X, Y}) ->
+    expr(X) + expr(Y);
+expr({equal, X, Y}) ->
+    bool(expr(X) == expr(Y));
+expr({gt, X, Y}) ->
+    bool(expr(X) > expr(Y));
+expr({knot, X}) ->
+    case expr(X) of
+        0 -> 1;
+        _ -> 0
+    end.
+
+bool(true) -> 1;
+bool(false) -> 0.
diff --git a/lib/syntax_tools/examples/merl/basic_test.erl b/lib/syntax_tools/examples/merl/basic_test.erl
new file mode 100644
index 0000000000..ff35de6325
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/basic_test.erl
@@ -0,0 +1,77 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Tests. For including in another module.
+
+%-module(basic_test).
+%-import(basic, run/1)
+
+-export([basic_fib/1]).
+
+-include_lib("eunit/include/eunit.hrl").
+
+basics_test_() ->
+    [?_assertEqual(42, run(1,[{1,{stop, 42}}])),
+     ?_assertEqual("hello", run(1,[{1,{stop,"hello"}}])),
+     ?_assertEqual(0, run(1,[{1,{print, "hello ~w", [42]}}])),
+     ?_assertEqual(5, run(1,[{1,{stop, {plus, 2, 3}}}])),
+     ?_assertEqual(5, run(1,[{1,{stop,{plus, 8, -3}}}])),
+     ?_assertEqual(0, run(1,[{1,{stop,{equal, 0, 1}}}])),
+     ?_assertEqual(1, run(1,[{1,{stop,{equal, 1, 1}}}])),
+     ?_assertEqual(0, run(1,[{1,{stop,{gt, 0, 1}}}])),
+     ?_assertEqual(0, run(1,[{1,{stop,{gt, 1, 1}}}])),
+     ?_assertEqual(1, run(1,[{1,{stop,{gt, 2, 1}}}])),
+     ?_assertEqual(0, run(1,[{1,{stop,{knot, 42}}}])),
+     ?_assertEqual(1, run(1,[{1,{stop,{knot, 0}}}])),
+     ?_assertEqual(42, run(1,[{1,{set, x, 42}}, {2,{stop,x}}])),
+     ?_assertEqual(17, run(1,[{1,{iff, 1, 2, 3}},
+                              {2,{stop, 17}},
+                              {3,{stop, 42}}])),
+     ?_assertEqual(42, run(1,[{1,{iff, 0, 2, 3}},
+                              {2,{stop, 17}},
+                              {3,{stop, 42}}])),
+     ?_assertEqual(17, run(1,[{1,{iff, 1, 2, 3}},
+                              {2,{stop, 17}},
+                              {3,{stop, -1}}])),
+     ?_assertEqual(42, run(1,[{1,{iff, 0, 2, 3}},
+                              {2,{stop, -1}},
+                              {3,{stop, 42}}]))
+
+
+    ].
+
+
+fib_test_() ->
+    [?_assertEqual(fib(N), basic_fib(N)) || N <- lists:seq(1,15)
+    ].
+
+
+fib(N) when N > 1 ->
+    fib(N-1) + fib(N-2);
+fib(_) ->
+    1.
+
+basic_fib(N) ->
+    run(1,
+        [{1,{set,x,0}},
+         {2,{set,a,1}},
+         {3,{set,b,0}},
+         {10,{iff, {equal, x, N}, 20, 30}},
+         {20,{stop,a}},
+         {30,{print,"~w, ~w, ~w\n",[x,a,b]}},
+         {31,{set,t,a}},
+         {32,{set,a,{plus,a,b}}},
+         {33,{set,b,t}},
+         {34,{set,x,{plus,x,1}}},
+         {40,{goto,10}}
+         ]).
diff --git a/lib/syntax_tools/examples/merl/basicc.erl b/lib/syntax_tools/examples/merl/basicc.erl
new file mode 100644
index 0000000000..531ac51538
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/basicc.erl
@@ -0,0 +1,149 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Basic compiler in Erlang.
+
+-module(basicc).
+
+-export([run/2, make_lines/1, bool/1]).
+
+-include_lib("eunit/include/eunit.hrl").
+
+-define(INTERPRETED, true).
+-include("basic_test.erl").
+
+-include("merl.hrl").
+
+run(N, Prog) ->
+    compile(Prog, tmp),
+    tmp:run(N, Prog).
+
+make_lines(Prog) ->
+    ets:new(line, [private, named_table, ordered_set]),
+    lists:foreach(fun ({L,_}) -> ets:insert(line, {L,label(L)}) end, Prog).
+
+compile(Prog, ModName) ->
+    make_lines(Prog),
+    Fs0 = lists:map(fun ({L, X}) ->
+                            {true, label(L),
+                             case stmt(X) of
+                                 {Stmt, false} ->
+                                     [?Q("() -> _@Stmt")];
+                                 {Stmt, true} ->
+                                     Next = case ets:next(line, L) of
+                                                '$end_of_table' ->
+                                                    ?Q("stop(0)");
+                                                L1 ->
+                                                    Label = label(L1),
+                                                    ?Q("_@Label@()")
+                                            end,
+                                     [?Q("() -> _@Stmt, _@Next")]
+                             end}
+                    end, Prog),
+    ets:delete(line),
+    Run = ?Q(["(N, Prog) ->",
+              " ets:new(var, [private, named_table]),",
+              " basicc:make_lines(Prog),",
+              " goto(N)"
+             ]),
+    Stop = ?Q(["(R) ->",
+               " ets:delete(var),",
+               " ets:delete(line),",
+               " R"
+              ]),
+    Goto =  ?Q(["(L) ->",
+                " case ets:lookup(line, L) of",
+                "  [{_, X}] -> apply(tmp, X, []);",
+                "  _ ->",
+                "   case ets:next(line, L) of",
+                "    '$end_of_table' -> stop(0);",
+                "    L1 -> goto(L1)",
+                "   end",
+                " end"]),
+    Fs = [{true, run, [Run]},
+          {false, stop, [Stop]},
+          {true, goto, [Goto]}
+          | Fs0],
+    Forms = merl_build:module_forms(
+              lists:foldl(fun ({X, Name, Cs}, S) ->
+                                  merl_build:add_function(X, Name, Cs, S)
+                          end,
+                          merl_build:init_module(ModName),
+                          Fs)),
+    %% %% Write source to file for debugging
+    %% file:write_file(lists:concat([ModName, "_gen.erl"]),
+    %%                 erl_prettypr:format(erl_syntax:form_list(Forms),
+    %%                                     [{paper,160},{ribbon,80}])),
+    merl:compile_and_load(Forms, [verbose]).
+
+label(L) ->
+    list_to_atom("label_" ++ integer_to_list(L)).
+
+stmt({print, S, As}) ->
+    Exprs = [expr(A) || A <- As],
+    {[?Q(["io:format(_@S@, [_@Exprs])"])], true};
+stmt({set, V, X}) ->
+    Expr = expr(X),
+    {[?Q(["ets:insert(var, {_@V@, _@Expr})"])], true};
+stmt({goto, X}) ->
+    {[jump(X)], false};
+stmt({stop, X}) ->
+    Expr = expr(X),
+    {[?Q(["stop(_@Expr)"])], false};
+stmt({iff, X, A, B}) ->
+    Cond = expr(X),
+    True = jump(A),
+    False = jump(B),
+    {?Q(["case _@Cond of",
+         "  0 -> _@False;",
+         "  _ -> _@True",
+         "end"]),
+     false}.
+
+jump(X) ->
+    case ets:lookup(line, X) of
+        [{_, F}] ->
+            ?Q(["_@F@()"]);
+        true ->
+            Expr = expr(X),
+            [?Q(["goto(_@Expr)"])]
+    end.
+
+expr(X) when is_number(X) ; is_list(X) ->
+    ?Q("_@X@");
+expr(X) when is_atom(X) ->
+    ?Q(["case ets:lookup(var, _@X@) of",
+        " [] -> 0;",
+        " [{_,V}] -> V",
+        "end"]);
+expr({plus, X, Y}) ->
+    ExprX = expr(X),
+    ExprY = expr(Y),
+    ?Q("_@ExprX + _@ExprY");
+expr({equal, X, Y}) ->
+    ExprX = expr(X),
+    ExprY = expr(Y),
+    ?Q("basicc:bool(_@ExprX == _@ExprY)");
+expr({gt, X, Y}) ->
+    ExprX = expr(X),
+    ExprY = expr(Y),
+    ?Q("basicc:bool(_@ExprX > _@ExprY)");
+expr({knot, X}) ->
+    Expr = expr(X),
+    ?Q(["case _@Expr of",
+        " 0 -> 1;",
+        " _ -> 0",
+        "end"]).
+
+bool(true) -> 1;
+bool(false) -> 0.
diff --git a/lib/syntax_tools/examples/merl/lisp.erl b/lib/syntax_tools/examples/merl/lisp.erl
new file mode 100644
index 0000000000..371dc6b261
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/lisp.erl
@@ -0,0 +1,160 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Trivial Lisp interpreter in Erlang.
+
+-module(lisp).
+
+-export([eval/1]).
+
+-export([init/0, equal/2, gt/2, knot/1]).
+
+-record(st, {env}).
+
+-define(INTERPRETED, true).
+-include("lisp_test.erl").
+
+eval(P) ->
+    {X, _} = eval(P, init()),
+    X.
+
+init() ->
+    Env = [{print, {builtin, fun do_print/2}}
+           ,{list, {builtin, fun do_list/2}}
+           ,{apply, {builtin, fun do_apply/2}}
+           ,{plus, {builtin, fun do_plus/2}}
+           ,{equal, {builtin, fun do_equal/2}}
+           ,{gt, {builtin, fun do_gt/2}}
+           ,{knot, {builtin, fun do_knot/2}}
+           ,{y, y()}
+          ],
+    #st{env=dict:from_list(Env)}.
+
+eval([lambda, Ps, B], #st{env=E}=St) when is_list(Ps) ->
+    case lists:all(fun is_atom/1, Ps) andalso
+        (length(Ps) =:= length(lists:usort(Ps))) of
+        true -> {{lambda, Ps, B, E}, St};
+        false -> throw(bad_lambda)
+    end;
+eval([lambda | _], _) ->
+    throw(bad_lambda);
+eval([def, A, V, B], #st{env=E0}=St) when is_atom(A) ->
+    {V1, St1} = eval(V, St),
+    E1 = bind(A, V1, E0),
+    {X, St2} = eval(B, St1#st{env=E1}),
+    {X, St2#st{env=E0}};
+eval([def | _], _) ->
+    throw(bad_def);
+eval([quote, A], St) ->
+    {A, St};
+eval([quote | _], _) ->
+    throw(bad_quote);
+eval([iff, X, A, B], St) ->
+    case eval(X, St) of
+        {[], St1} -> eval(B, St1);
+        {_, St1} -> eval(A, St1)
+    end;
+eval([do], _St0) ->
+    throw(bad_do);
+eval([do | As], St0) ->
+    lists:foldl(fun (X, {_,St}) -> eval(X, St) end, {[],St0}, As);
+eval([_|_]=L, St) ->
+    {[F | As], St1} = lists:mapfoldl(fun eval/2, St, L),
+    call(F, As, St1);
+eval(A, St) when is_atom(A) ->
+    {deref(A, St), St};
+eval(C, St) ->
+    {C, St}.
+
+%% UTILITY FUNCTIONS
+
+deref(A, #st{env=E}) ->
+    case dict:find(A, E) of
+        {ok, V} -> V;
+        error -> throw({undefined, A})
+    end.
+
+bind(A, V, E) ->
+    dict:store(A, V, E).
+
+bind_args([P | Ps], [A | As], E) ->
+    bind_args(Ps, As, dict:store(P, A, E));
+bind_args([], [], E) ->
+    E;
+bind_args(_, _, _) ->
+    throw(bad_arity).
+
+call({lambda, Ps, B, E}, As, #st{env=E0}=St) ->
+    {X, St1} = eval(B, St#st{env=bind_args(Ps, As, E)}),
+    {X, St1#st{env=E0}};
+call({builtin, F}, As, St) ->
+    F(As, St);
+call(X, _, _) ->
+    throw({bad_fun, X}).
+
+bool(true) -> 1;
+bool(false) -> [].
+
+%% BUILTINS
+
+y() ->
+    {Y, _} = eval([lambda, [f],
+                   [[lambda, [x], [f, [lambda, [y], [[x, x], y]]]],
+                    [lambda, [x], [f, [lambda, [y], [[x, x], y]]]]]],
+                  #st{env=dict:new()}),
+    Y.
+
+do_print([S | Xs], St) ->
+    io:format(S, Xs),
+    {[], St};
+do_print(_, _) ->
+    throw(bad_print).
+
+do_list(As, St) ->
+    {As, St}.
+
+do_apply([F, As], St) ->
+    call(F, As, St);
+do_apply(_, _) ->
+    throw(bad_apply).
+
+do_plus([X, Y], St) when is_number(X), is_number(Y) ->
+    {X + Y, St};
+do_plus(As, _) ->
+    throw({bad_plus, As}).
+
+do_equal([X, Y], St) ->
+    {equal(X, Y), St};
+do_equal(As, _) ->
+    throw({bad_equal, As}).
+
+equal(X, Y) ->
+    bool(X =:= Y).
+
+do_gt([X, Y], St) ->
+    {gt(X, Y), St};
+do_gt(As, _) ->
+    throw({bad_gt, As}).
+
+gt(X, Y) ->
+    bool(X > Y).
+
+do_knot([X], St) ->
+    {knot(X), St};
+do_knot(As, _) ->
+    throw({bad_gt, As}).
+
+knot([]) ->
+    1;
+knot(_) ->
+    [].
diff --git a/lib/syntax_tools/examples/merl/lisp_test.erl b/lib/syntax_tools/examples/merl/lisp_test.erl
new file mode 100644
index 0000000000..cab8134b8f
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/lisp_test.erl
@@ -0,0 +1,98 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Tests. For including in another module.
+
+%-module(lisp_test).
+%-import(lisp, eval/1)
+
+-export([fib/1, lisp_fib/1]).
+
+-include_lib("eunit/include/eunit.hrl").
+
+basics_test_() ->
+    [?_assertEqual(42, eval(42)),
+     ?_assertEqual("hello", eval([quote, "hello"])),
+     ?_assertEqual(print, eval([quote, print])),
+     ?_assertMatch([17,[1,2],42], eval([list,17,[list,1,2],42])),
+     ?_assertEqual([], eval([print, [quote, "hello ~w"], [list, 42]])),
+     ?_assertEqual(5, eval([plus, 2, 3])),
+     ?_assertEqual(5, eval([plus, 8, -3])),
+     ?_assertEqual([], eval([equal, 0, 1])),
+     ?_assertEqual(1, eval([equal, 1, 1])),
+     ?_assertEqual([], eval([gt, 0, 1])),
+     ?_assertEqual([], eval([gt, 1, 1])),
+     ?_assertEqual(1, eval([gt, 2, 1])),
+     ?_assertEqual([], eval([knot, 42])),
+     ?_assertEqual(1, eval([knot, []])),
+     ?_assertEqual(42, eval([do, 17, 42])),
+     ?_assertEqual([], eval([apply, print, [quote, ["~p", [42]]]])),
+     ?_assertEqual(42, eval([iff, [], 17, 42])),
+     ?_assertEqual(17, eval([iff, 1, 17, 42])),
+     ?_assertEqual(42, eval([iff, [], [apply], 42])),
+     ?_assertEqual(17, eval([iff, 1, 17, [apply]])),
+     ?_assertEqual(17, eval([def, foo, 17, foo])),
+     ?_assertEqual(17, eval([def, bar, 42, [def, foo, 17, foo]])),
+     ?_assertEqual(42, eval([def, bar, 42, [def, foo, 17, bar]])),
+     ?_assertEqual(17, eval([def, foo, 42, [def, foo, 17, foo]]))
+    ].
+
+-ifdef(INTERPRETED).
+interpreter_basics_test_() ->
+    [?_assertThrow({undefined, foo}, eval(foo)),
+     ?_assertMatch({builtin,_}, eval(print)),
+     ?_assertThrow(bad_do, eval([do])),
+     ?_assertThrow(bad_apply, eval([apply])),
+     ?_assertThrow({undefined, foo}, eval([def, bar, 17, foo]))
+    ].
+
+interpreter_lambda_test_() ->
+    [?_assertMatch({lambda,_,_,_}, eval([lambda, [], 42])),
+     ?_assertMatch({lambda,_,_,_}, eval([lambda, [x], x])),
+     ?_assertMatch({lambda,_,_,_}, eval([lambda, [x,y], 42]))
+    ].
+-endif.
+
+lambda_test_() ->
+    [?_assertThrow(bad_lambda, eval([lambda])),
+     ?_assertThrow(bad_lambda, eval([lambda, []])),
+     ?_assertThrow(bad_lambda, eval([lambda, [], 17, 42])),
+     ?_assertThrow(bad_lambda, eval([lambda, 17, 42])),
+     ?_assertThrow(bad_lambda, eval([lambda, [17], 42])),
+     ?_assertThrow(bad_lambda, eval([lambda, [foo, foo], 42])),
+     ?_assertEqual(42, eval([[lambda, [x], x], 42])),
+     ?_assertEqual([42, 17], eval([[lambda, [x], [list, x, 17]], 42])),
+     ?_assertEqual([42, 17], eval([def, f, [def, y, 42,
+                                            [lambda, [x], [list, y, x]]],
+                                   [f, 17]]))
+    ].
+
+fib_test_() ->
+    [?_assertEqual(fib(N), lisp_fib(N)) || N <- lists:seq(1,15)
+    ].
+
+
+fib(N) when N > 1 ->
+    fib(N-1) + fib(N-2);
+fib(_) ->
+    1.
+
+lisp_fib(N) ->
+    eval([def, fib,
+          [y, [lambda, [f], [lambda, [x],
+                             [iff, [gt, x, 1],
+                              [plus, [f, [plus,x,-1]], [f, [plus,x,-2]]],
+                              1]
+                            ]]],
+          [fib, N]
+         ]).
diff --git a/lib/syntax_tools/examples/merl/lispc.erl b/lib/syntax_tools/examples/merl/lispc.erl
new file mode 100644
index 0000000000..97072cdab7
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/lispc.erl
@@ -0,0 +1,102 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Lisp compiler in Erlang.
+
+-module(lispc).
+
+-export([eval/1]).
+
+-record(st, {}).
+
+-include("lisp_test.erl").
+
+-include("merl.hrl").
+
+eval(Lisp) ->
+    compile(Lisp, tmp),
+    tmp:eval().
+
+compile(Lisp, ModName) ->
+    {Code, _} = gen(Lisp, #st{}),
+    Main = ?Q(["() ->",
+               "  __print = fun (S, Xs) -> io:format(S,Xs), [] end,",
+               "  __apply = fun erlang:apply/2,",
+               "  __plus = fun erlang:'+'/2,",
+               "  __equal = fun lisp:equal/2,",
+               "  __gt = fun lisp:gt/2,",
+               "  __knot = fun lisp:knot/1,",
+               "  __y = fun (F) ->",
+               "          (fun (X) -> F(fun (Y) -> (X(X))(Y) end) end)",
+               "           (fun (X) -> F(fun (Y) -> (X(X))(Y) end) end)",
+               "     end,",
+               "  _@Code"]),
+    Forms = merl_build:module_forms(
+              merl_build:add_function(true, eval, [Main],
+                                      merl_build:init_module(ModName))),
+    %% %% Write source to file for debugging
+    %% file:write_file(lists:concat([ModName, "_gen.erl"]),
+    %%                 erl_prettypr:format(erl_syntax:form_list(Forms),
+    %%                                     [{paper,160},{ribbon,80}])),
+    merl:compile_and_load(Forms, [verbose]).
+
+var(Atom) ->
+    merl:var(list_to_atom("__" ++ atom_to_list(Atom))).
+
+gen([lambda, Ps, B], St) when is_list(Ps) ->
+    case lists:all(fun is_atom/1, Ps) andalso
+        (length(Ps) =:= length(lists:usort(Ps))) of
+        true ->
+            Vars = [var(P) || P <- Ps],
+            {Body, St1} = gen(B, St),
+            {?Q("fun (_@Vars) -> _@Body end"), St1};
+        false ->
+            throw(bad_lambda)
+    end;
+gen([lambda | _], _) ->
+    throw(bad_lambda);
+gen([def, A, V, B], St) when is_atom(A) ->
+    Var = var(A),
+    {Val, St1} = gen(V, St),
+    {Body, St2} = gen(B, St1),
+    {?Q("(fun (_@Var) -> _@Body end)(_@Val)"), St2};
+gen([def | _], _) ->
+    throw(bad_def);
+gen([quote, A], St) ->
+    {merl:term(A), St};
+gen([quote | _], _) ->
+    throw(bad_quote);
+gen([iff, X, A, B], St) ->
+    {Cond, St1} = gen(X, St),
+    {True, St2} = gen(A, St1),
+    {False, St3} = gen(B, St2),
+    {?Q(["case _@Cond of",
+         "  [] -> _@False;",
+         "  _ -> _@True",
+         "end"]),
+     St3};
+gen([do], _) ->
+    throw(bad_do);
+gen([do | As], St0) ->
+    {Body, St1} = lists:mapfoldl(fun gen/2, St0, As),
+    {?Q("begin _@Body end"), St1};
+gen([list | As], St0) ->
+    {Elem, St1} = lists:mapfoldl(fun gen/2, St0, As),
+    {?Q("[ _@Elem ]"), St1};
+gen([_|_]=L, St) ->
+    {[F | As], St1} = lists:mapfoldl(fun gen/2, St, L),
+    {?Q("((_@F)(_@As))"), St1};
+gen(A, St) when is_atom(A) ->
+    {var(A), St};
+gen(C, St) ->
+    {merl:term(C), St}.
diff --git a/lib/syntax_tools/examples/merl/merl_build.erl b/lib/syntax_tools/examples/merl/merl_build.erl
new file mode 100644
index 0000000000..c539f8e2af
--- /dev/null
+++ b/lib/syntax_tools/examples/merl/merl_build.erl
@@ -0,0 +1,104 @@
+%% ---------------------------------------------------------------------
+%% Licensed under the Apache License, Version 2.0 (the "License"); you may
+%% not use this file except in compliance with the License. You may obtain
+%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2012 Richard Carlsson
+%% @doc Making it simple to build a module with merl
+
+-module(merl_build).
+
+-export([init_module/1, module_forms/1, add_function/4, add_record/3,
+         add_import/3, add_attribute/3, set_file/2]).
+
+-import(merl, [term/1]).
+
+-include("merl.hrl").
+
+-type filename() :: string().
+
+-record(module, { name          :: atom()
+                , file          :: filename()
+                , exports=[]    :: [{atom(), integer()}]
+                , imports=[]    :: [{atom(), [{atom(), integer()}]}]
+                , attributes=[] :: [{filename(), atom(), [term()]}]
+                , records=[]    :: [{filename(), atom(),
+                                     [{atom(), merl:tree()}]}]
+                , functions=[]  :: [{filename(), atom(), [merl:tree()]}]
+                }).
+
+%% TODO: init module from a list of forms (from various sources)
+
+%% @doc Create a new module representation, using the given module name.
+init_module(Name) when is_atom(Name) ->
+    %% use the module name as the default file name - better than nothing
+    #module{name=Name, file=atom_to_list(Name)}.
+
+%% @doc Get the list of syntax tree forms for a module representation. This can
+%% be passed to compile/2.
+module_forms(#module{name=Name,
+                     exports=Xs,
+                     imports=Is,
+                     records=Rs,
+                     attributes=As,
+                     functions=Fs})
+  when is_atom(Name), Name =/= undefined ->
+    Module = ?Q("-module('@Name@')."),
+    Exported = [erl_syntax:arity_qualifier(term(N), term(A))
+                || {N,A} <- ordsets:from_list(Xs)],
+    Export = ?Q("-export(['@_Exported'/1])."),
+    Imports = [?Q("-import('@M@', ['@_NAs'/1]).")
+               || {M, Ns} <- Is,
+                  NAs <- [[erl_syntax:arity_qualifier(term(N), term(A))
+                           || {N,A} <- ordsets:from_list(Ns)]]
+              ],
+    Attrs = [?Q("-file(\"'@File@\",1). -'@N@'('@T@').")
+             || {File, N, T} <- lists:reverse(As)],
+    Records = [?Q("-file(\"'@File@\",1). -record('@N@',{'@_RFs'=[]}).")
+               || {File, N, Es} <- lists:reverse(Rs),
+                  RFs <- [[erl_syntax:record_field(term(F), V)
+                           || {F,V} <- Es]]
+              ],
+    Functions = [?Q("-file(\"'@File@\",1). '@_F'() -> [].")
+                 || {File, N, Cs} <- lists:reverse(Fs),
+                    F <- [erl_syntax:function(term(N), Cs)]],
+    lists:flatten([Module, Export, Imports, Attrs, Records, Functions]).
+
+%% @doc Set the source file name for all subsequently added functions,
+%% records, and attributes.
+set_file(Filename, #module{}=M) ->
+    M#module{file=filename:flatten(Filename)}.
+
+%% @doc Add a function to a module representation.
+add_function(Exported, Name, Clauses,
+             #module{file=File, exports=Xs, functions=Fs}=M)
+  when is_boolean(Exported), is_atom(Name), Clauses =/= [] ->
+    Arity = length(erl_syntax:clause_patterns(hd(Clauses))),
+    Xs1 = case Exported of
+              true -> [{Name,Arity} | Xs];
+              false -> Xs
+          end,
+    M#module{exports=Xs1, functions=[{File, Name, Clauses} | Fs]}.
+
+%% @doc Add a record declaration to a module representation.
+add_record(Name, Fields, #module{file=File, records=Rs}=M)
+  when is_atom(Name) ->
+    M#module{records=[{File, Name, Fields} | Rs]}.
+
+%% @doc Add a "wild" attribute, such as `-compile(Opts)' to a module
+%% representation. Note that such attributes can only have a single argument.
+add_attribute(Name, Term, #module{file=File, attributes=As}=M)
+  when is_atom(Name) ->
+    M#module{attributes=[{File, Name, Term} | As]}.
+
+%% @doc Add an import declaration to a module representation.
+add_import(From, Names, #module{imports=Is}=M)
+  when is_atom(From), is_list(Names) ->
+    M#module{imports=[{From, Names} | Is]}.