From: Mark Wooding <mdw@distorted.org.uk>
Date: Sun, 20 Jun 2010 12:02:59 +0000 (+0100)
Subject: New language: Erlang.
X-Git-Url: https://git.distorted.org.uk/~mdw/fringe/commitdiff_plain/18b71d38307a6eebd659cf3f39229e987cfd20ee

New language: Erlang.
---

diff --git a/.gitignore b/.gitignore
index af9faf9..f5b66db 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,3 +10,4 @@ test.log
 *.8
 *.6
 *.fasl
+*.beam
diff --git a/Makefile b/Makefile
index 7a4f553..e83ae5e 100644
--- a/Makefile
+++ b/Makefile
@@ -178,6 +178,23 @@ smalltalk-fringe:
 	} >$@.new
 	$(V_HIDE)chmod +x $@.new && mv $@.new $@
 
+###--------------------------------------------------------------------------
+### Erlang.
+
+ERLC			 = erlc
+CLEANFILES		+= *.beam erl_crash.dump
+.SUFFIXES: .erl .beam
+.erl.beam:; $(call v_echo,ERLC)$(ERLC) $(ERLCFLAGS) $<
+
+LANGS			+= erl
+TARGETS			+= erl-fringe.beam
+SOURCES			+= erl-fringe.erl
+erl-fringe:
+	$(call v_echo,GENSH){ echo '#! /bin/sh';			\
+	  echo 'exec erl -pa . -noshell -run erl-fringe main -extra "$$@"'; \
+	} >$@.new
+	$(V_HIDE)chmod +x $@.new && mv $@.new $@
+
 ###----- That's all, folks --------------------------------------------------
 
 all:: $(TARGETS)
diff --git a/erl-fringe.erl b/erl-fringe.erl
new file mode 100644
index 0000000..77239bd
--- /dev/null
+++ b/erl-fringe.erl
@@ -0,0 +1,129 @@
+%%% -*-erlang-*-
+%%%
+%%% Erlang implementation of a `same-fringe' solver.
+
+-module('erl-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('erl-fringe', tree_fringe, [T]),
+		map_iterator(I, fun(X) -> io:put_chars([X]) end),
+		io:nl();
+	    [S, SS] ->
+		I = iterator('erl-fringe', tree_fringe, [parse_tree(S)]),
+		J = iterator('erl-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, "erl-fringe: ~s~n", [M]),
+	    init:stop(1)
+    end,
+    init:stop().
+
+%%%----- That's all, folks --------------------------------------------------