erlang: Rename language from `erl'.

[fringe] / erlang-fringe.erl

diff --git a/erlang-fringe.erl b/erlang-fringe.erl
new file mode 100644 (file)
index 0000000..5854cb8
--- /dev/null
+++ b/erlang-fringe.erl
@@ -0,0 +1,129 @@
+%%% -*-erlang-*-
+%%%
+%%% Erlang implementation of a `same-fringe' solver.
+
+-module('erlang-fringe').
+-export([main/0, tree_fringe/1]).
+
+%%%--------------------------------------------------------------------------
+%%% Iteration protocol.
+
+%% An iterator is a process I which responds to the message {next, P} by
+%% sending to process P either {item, I, X} or {done, I}.  (The iterator's
+%% process id helps us work out which iterator we're getting a reply from.)
+
+yield(X) ->
+    %% Called from an iterator: yield the term X.
+    receive
+       {next, P} -> P ! {item, self(), X}
+    end.
+
+next(I) ->
+    %% Fetch the next item from the iterator I, as a tuple {item, X}, or the
+    %% symbol `done' if there's nothing left..
+    I ! {next, self()},
+    receive
+       {item, I, X} -> {item, X};
+       {done, I} -> done
+    end.
+
+iterator(M, F, A) ->
+    %% Create and return an iterator process given a function F in module M,
+    %% passing it the argument list A.
+    spawn(fun () ->
+             apply(M, F, A),
+             receive
+                 {next, P} -> P ! {done, self()}
+             end
+         end).
+
+map_iterator(I, F) ->
+    %% Apply F to each item returned from the iterator I.  Return the atom
+    %% `done'.
+    case next(I) of
+       {item, X} ->
+           apply(F, [X]),
+           map_iterator(I, F);
+       done ->
+           done
+    end.
+
+iterators_equal(I, J) ->
+    %% Answer whether the iterators I and J return the same elements, as
+    %% decided by pattern-matching.
+    X = next(I),
+    Y = next(J),
+    case {X, Y} of
+       {done, done} -> true;
+       {{item, Z}, {item, Z}} -> iterators_equal(I, J);
+       _ -> false
+    end.
+
+%%%--------------------------------------------------------------------------
+%%% Node structure.
+
+%% A tree is either the atom `nil' or a tuple {LEFT, DATUM, RIGHT} of the
+%% LEFT and RIGHT subtrees and the DATUM, which may be any term.
+
+%% Iteration is easy.  We just use a separate process.
+tree_fringe({L, D, R}) ->
+    tree_fringe(L),
+    yield(D),
+    tree_fringe(R);
+tree_fringe(nil) ->
+    ignore.
+
+%% Parse a tree from a textual description.  The syntax is simple:
+%%
+%%     tree ::= empty | `(' tree char tree `)'
+%%
+%% where the ambiguity is resolved by declaring that a `(' is a tree if we're
+%% expecting a tree.
+do_parse_tree([$( | S]) ->
+    case do_parse_tree(S) of
+       {L, [D | SS]} ->
+           case do_parse_tree(SS) of
+               {R, [$) | SSS]} -> {{L, D, R}, SSS};
+               _ -> throw({simple_error, "missing )"})
+           end;
+       _ ->
+           throw({simple_error, "no data"})
+    end;
+do_parse_tree(S) ->
+    {nil, S}.
+
+parse_tree(S) ->
+    case do_parse_tree(S) of
+       {T, []} -> T;
+       _ -> throw({simple_error, "trailing junk"})
+    end.
+
+%%%--------------------------------------------------------------------------
+%%% Main program.
+
+main() ->
+    try
+       case init:get_plain_arguments() of
+           [S] ->
+               T = parse_tree(S),
+               I = iterator('erlang-fringe', tree_fringe, [T]),
+               map_iterator(I, fun(X) -> io:put_chars([X]) end),
+               io:nl();
+           [S, SS] ->
+               I = iterator('erlang-fringe', tree_fringe, [parse_tree(S)]),
+               J = iterator('erlang-fringe', tree_fringe, [parse_tree(SS)]),
+               case iterators_equal(I, J) of
+                   true -> io:format("match~n");
+                   _ -> io:format("no match~n")
+               end;
+           _ ->
+               throw({simple_error, "bad args"})
+       end
+    catch
+       {simple_error, M} ->
+           io:format(standard_error, "erlang-fringe: ~s~n", [M]),
+           init:stop(1)
+    end,
+    init:stop().
+
+%%%----- That's all, folks --------------------------------------------------