ebb/compiler/compile

#!/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
                       $* -> "xml";
                       $+ -> "xpl";
                       $/ -> "xdv";
                       $- -> "xmn";
                       $_ -> "xus";
                       $< -> "xlt";
		       $> -> "xgt";
		       $= -> "xeq";
		       $! -> "xex";
		       $? -> "xqs";
		       $: -> "xcn";
		       $x -> "xxx";
		       $X -> "xXX";
		       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({atom, X}) -> to_erlang_atom(X);
to_erlang_atom(S) ->
    string:to_lower(
      lists:foldr(fun(X, Y) -> X ++ Y end, "",
		  lists:map(fun(C) -> char_convert(C) end, S))).

% Convert a string representing a Scheme identifier to a string representing
% an Erlang variable, i.e. upper-case.
to_erlang_variable({atom, X}) -> to_erlang_variable(X);
to_erlang_variable(S) ->
    string:to_upper(
      lists:foldr(fun(X, Y) -> X ++ Y end, "",
		  lists:map(fun(C) -> char_convert(C) end, S))).

% 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", []).