Merge branch 'master' of github.com:aisamanra/ebb

compiler/compile

@@ -0,0 +1,209 @@
+#!/usr/bin/escript
+%% -*- erlang -*-
+%%! -smp enable -sname factorial -mnesia debug verbose
+
+
+%%% CONSTANTS %%%
+% Mostly used for built-in Scheme functions.
+
+-define(PRELUDE, ["+", "-", "*", "/", "=", "<", ">", "<=", ">=",
+		  "cons", "list", "append", "car", "cdr", "map",
+		  "filter", "member", "list-ref"]).
+
+%%% LEXING %%%
+
+% Lex a string representing Scheme code into a list.
+lex(S) -> lists:filter(fun(Match) -> (Match /= "") and
+                                     (re:run(Match, "[ \n]+") == nomatch) end,
+                       re:split(S, "(\()|(\))|(')|([^ \n()']+)", [{return, list}])).
+
+
+%%% PARSING %%%
+
+% String -> Regex -> Bool
+% true if Regex matches the entirety of Str; false otherwise.
+string_matches(Str, Regex) -> case re:run(Str, Regex, [{capture, first, list}]) of
+                           {match, [S]} -> S == Str;
+                           _ -> false
+                       end.
+
+% String -> Bool
+% true if Str consists entirely of number characters; false otherwise.
+is_number_string(Str) -> string_matches(Str, "[0-9]+").
+
+% [String] -> Heterogeneous List
+% Returns the tuple { Parsed, Unparsed } consisting of a deep list of
+% parsed tokens and a flat list of unparsed tokens.
+parse([]) -> [];
+parse(["(" | Rest]) -> parse_list(Rest);
+parse([")" | _]) -> error;
+parse(["'" | Rest]) -> case parse(Rest) of
+			   {Dat, R} ->
+			       {[{atom, "quote"}, Dat], R};
+			   error ->
+			       error
+		       end;
+parse([S | Rest]) -> case is_number_string(S) of
+			 true ->
+			     {{number, S}, Rest};
+			 false ->
+			     {{atom, S}, Rest}
+		     end.
+
+
+parse_list([]) -> {[], []};
+parse_list([")" | Rest]) -> {[], Rest};
+parse_list(S) -> case parse(S) of
+                     {L, R} -> case parse_list(R) of
+                                       {List, Rest} -> {lists:append([L], List),
+                                                        Rest};
+                                       error -> error
+                               end;
+                     error -> error
+                 end.
+
+%%% COMPILATION %%%
+
+% Char -> String
+% converts a Scheme character to an Erlang character for identifiers; converts
+% certain special characters to three-character equivalents.
+char_convert(C) -> case C of
+                       $* -> "_ml";
+                       $+ -> "_pl";
+                       $/ -> "_dv";
+                       $- -> "_mn";
+                       $_ -> "_us";
+                       $< -> "_lt";
+		       $> -> "_gt";
+		       $= -> "_eq";
+		       $! -> "_ex";
+		       $? -> "_qs";
+		       $: -> "_cn";
+		       X -> [X]
+                   end.
+
+snd({_, X}) -> X;
+snd(_) -> error.
+
+% a -> Bool
+% Well; "string" is more properly "is a list of non-lists", which also (in this case)
+% includes strings and lists of integers indistinguishably. With that caveat--
+% recogizes whether something is a "string".
+is_string(S) ->
+  is_list(S) and lists:foldl(fun(X, Y) -> X and Y end, true,
+                             lists:map(fun(X) -> not(is_list(X)) end, S)).
+
+% Heterogeneous List of Strings -> String
+deep_string_append(L) ->
+  string:join(lists:map(fun(M) -> case is_string(M) of
+                                      true -> M;
+                                      false -> deep_string_append(M)
+                                  end end, L),
+	      "").
+
+% String -> String
+% Convert a string representing a Scheme identifier to a string representing
+% an Erlang function identifier or an atom, i.e. lower-case
+to_erlang_atom([S|XS]) ->
+  lists:foldr(fun(X, Y) -> X ++ Y end, "",
+    lists:map(fun(C) -> char_convert(C) end,
+              [string:to_lower(S)|XS]));
+to_erlang_atom({atom, X}) -> to_erlang_atom(X).
+
+% Convert a string representing a Scheme identifier to a string representing
+% an Erlang variable, i.e. upper-case.
+to_erlang_variable([S|XS]) ->
+  lists:foldr(fun(X, Y) -> X ++ Y end, "",
+    lists:map(fun(C) -> char_convert(C) end,
+              [string:to_upper(S)|XS]));
+to_erlang_variable({atom, X}) -> to_erlang_variable(X).
+
+% Heterogeneous List -> String
+generate([{atom, "define"} |
+	  [ [Name | Args] | Body]], Vars, Variadics) ->
+    Bareargs = lists:map(fun(X) -> snd(X) end, Args),
+    [to_erlang_atom(Name),
+     " ( ", string:join(
+	      lists:map(fun(X) -> to_erlang_variable(X) end, Args),
+	      " , "), " ) -> ",
+     string:join(lists:map(fun(X) -> generate(X, Vars ++ Bareargs, Variadics) end,
+			   Body), " ; "),
+    " . "];
+generate([{atom, "lambda"} | [Args | Body]], Vars, Variadics) ->
+    Bareargs = lists:map(fun(X) -> snd(X) end, Args),
+    ["fun (",
+     string:join(
+       lists:map(fun(X) -> to_erlang_variable(X) end, Args),
+       " , "),
+     ") -> ",
+     string:join(lists:map(fun(X) -> generate(X, Vars ++ Bareargs, Variadics) end,
+			   Body), " ; "),
+     "end"];
+generate([{atom, "if"}
+	  | [ Condition 
+	     | [ Then_Case
+		| [ Else_Case ]]]], Vars, Variadics) ->
+    ["case scheme_prelude:is_true( ",
+     generate(Condition, Vars, Variadics),
+     ") of true -> ",
+     generate(Then_Case, Vars, Variadics),
+     " ; false -> ",
+     generate(Else_Case, Vars, Variadics),
+     " end "];
+generate([{atom, "quote"} | [Rest]], _, _) ->
+    generate_quoted(Rest);
+generate([{atom, Func} | Args], Vars, Variadics) ->
+    case lists:member(Func, Variadics) of
+	true -> [generate({atom, Func}, Vars, Variadics),
+		 " ([ ",
+		 string:join(lists:map(fun(X) -> generate(X, Vars, Variadics) end, Args),
+			     [" , "]),
+		 " ]) "];
+	false -> [generate({atom, Func}, Vars, Variadics),
+		  " ( ",
+		  string:join(lists:map(fun(X) -> generate(X, Vars, Variadics) end, Args),
+			      [" , "]),
+		  " ) "]
+    end;
+generate({number, X}, _, _) -> [X];
+generate({atom, X}, Vars, _) ->
+    [case lists:member(X, Vars) of
+	 true -> to_erlang_variable(X);
+	 false -> case lists:member(X, ?PRELUDE) of
+		      true -> ["scheme_prelude:", to_erlang_atom(X)];
+		      false -> to_erlang_atom(X)
+		  end
+     end].
+
+generate_quoted({atom, X}) ->
+    [to_erlang_atom(X)];
+generate_quoted({number, X}) ->
+    [X];
+generate_quoted(List) ->
+    [" [ ", string:join(lists:map(fun(X) -> generate_quoted(X) end,
+			  List), [" , "]),
+    " ] "].
+
+% String -> String
+% Compiles a string representing Scheme code into a string representing an
+% Erlang module.
+compile(S) -> case parse_list(lex(S)) of
+                  {[X|_], _} -> deep_string_append(generate(X,
+							    [],
+							    ["-", "+", "*", "list"]));
+                  _ -> "NOTHING"
+              end.
+
+do_compile(Basename, Data) ->
+    io:format("-module(~s).\n-include(\"scheme_prelude.erl\").\n\n", [Basename]),
+    io:format("~s\n", [compile(Data)]).
+
+main([Filename]) ->
+    Basename = filename:basename(Filename, ".scm"),
+    case file:read_file(Filename) of
+	{ok, Contents} -> do_compile(Basename, Contents);
+	_ -> io:format("Error: bad file ~s\n", [Filename])
+    end;
+main(_) ->
+    io:format("No filename supplied!\n", []).
+