-module(egg).

-export([file/1, file/2, format_error/1]).

-import(lists, [concat/1, delete/2, flatmap/2, foldl/3, foldr/3,
                foreach/2, keydelete/3, keysearch/3, map/2, member/2,
                sort/1, usort/1]).

-record(symbol,  {
          line = none :: none | integer(),
          name        :: atom()
         }).

-type maybe_symbol() :: {} | #symbol{}.
-type token() :: {atom(), integer(), any()} | {atom(), integer()}.

-record(rule, {                     %% A rule alternative
          rhs    :: [atom()],       %% Right hand side symbols (as atoms)
          guard  :: maybe_symbol(), %% Guard of the rule alternative
          freq   :: maybe_symbol(), %% Probability of the rule alternative
          tokens :: [token()],      %% Attached code tokens (calculating value)
          attrmanip :: [token()],   %% Synthesised attribute computation
          nested :: #rule{}         %% Nested rule part after the ~> sign
         }).

-record(ruleset, {                 %% A production rule
          lhs     :: atom(),       %% Left hand side symbol of the rule
          rules   :: [#rule{}],    %% The rule alternatives
	  default :: [#rule{}]     %% Default value of the ruleset (~shrinking)
         }).

-define(ETSTAB,            egg_data).
-define(ASSUMED_EXTENSION, ".eyrl").
-define(S,                 erl_syntax).

-define(STEP(P), {P, fun P/0}).

%%% ============================================================================
%%% Interface

%% Running with the default options (reporting errors and warnings).

file(File) -> file(File, [report_errors, report_warnings]).

%% Options:
%% - out:             specifying the name of the resulting Erlang file
%% - report_errors:   report all errors occuring during the process
%%   report_warnings: report all warnings occuring during the process
%% - return_errors:   return errors as Erlang terms
%%   return_warnings: return warnings as Erlang terms
%% - time:            enable timing of the process steps
%% - verbose:         (currently no functionality)
%% - return:          return_errors + return_warnings
%%   report:          report_errors + report_warnings
%% - compile:         compile the resulting Erlang module

file(File, Options) ->
    case is_filename(File) of
        no -> erlang:error(badarg, [File, Options]);
        _  -> ok
    end,
    ets:new(?ETSTAB, [public, bag, named_table]),
    try set_options(Options)
    catch
        throw:badarg -> erlang:error(badarg, [File, Options])
    end,
    Self = self(),
    Pid = spawn_link(fun() -> main(Self, File) end),
    receive
        {Pid, Rep} ->
            receive after 1 -> ok end,
            process_flag(trap_exit, process_flag(trap_exit, false)),
            ets:delete(?ETSTAB),
            Rep
    end.

%% -----------------------------------------------------------------------------
%% Error formatting

format_error({cannot_compile_output, {error, _, _}}) ->
    compile:file(get_string(outfile), [basic_validation, report_errors]),
    io_lib:fwrite("cannot compile the output module", []);
format_error(bad_declaration) ->
    io_lib:fwrite("unknown or bad declaration ignored", []);
format_error({bad_rootsymbol, Sym}) ->
    io_lib:fwrite("rootsymbol ~s is not a nonterminal", [format_symbol(Sym)]);
format_error({duplicate_declaration, Tag}) ->
    io_lib:fwrite("duplicate declaration of ~s", [atom_to_list(Tag)]);
format_error({duplicate_nonterminal, Nonterminal}) ->
    io_lib:fwrite("duplicate non-terminals ~s", [format_symbol(Nonterminal)]);
format_error({duplicate_terminal, Terminal}) ->
    io_lib:fwrite("duplicate terminal ~s", [format_symbol(Terminal)]);
format_error({error, Module, Error}) ->
    Module:format_error(Error);
format_error({file_error, Reason}) ->
    io_lib:fwrite("~s",[file:format_error(Reason)]);
format_error({internal_error, Error}) ->
    io_lib:fwrite("internal egg error: ~w", [Error]);
%%format_error({missing_syntax_rule, Nonterminal}) ->
%%    io_lib:fwrite("no syntax rule for non-terminal symbol ~s",
%%                  [format_symbol(Nonterminal)]);
format_error(no_grammar_rules) ->
    io_lib:fwrite("grammar rules are missing", []);
format_error(nonterminals_missing) ->
    io_lib:fwrite("Nonterminals is missing", []);
format_error({symbol_terminal_and_nonterminal, SymName}) ->
    io_lib:fwrite("symbol ~s is both a terminal and nonterminal",
                  [format_symbol(SymName)]);
format_error(rootsymbol_missing) ->
    io_lib:fwrite("Rootsymbol is missing", []);
format_error(terminals_missing) ->
    io_lib:fwrite("Terminals are missing", []);
format_error({undefined_nonterminal, Symbol}) ->
    io_lib:fwrite("undefined nonterminal: ~s", [format_symbol(Symbol)]);
%%format_error({undefined_pseudo_variable, Atom}) ->
%%    io_lib:fwrite("undefined pseudo variable ~w", [Atom]);
format_error({undefined_symbol, SymName}) ->
    io_lib:fwrite("undefined rhs symbol ~s", [format_symbol(SymName)]).
%%format_error({unused_nonterminal, Nonterminal}) ->
%%    io_lib:fwrite("non-terminal symbol ~s not used",
%%                  [format_symbol(Nonterminal)]);
%%format_error({unused_terminal, Terminal}) ->
%%    io_lib:fwrite("terminal symbol ~s not used",
%%                  [format_symbol(Terminal)]).

%%% ============================================================================

%% -----------------------------------------------------------------------------
%% Option parsing

-define(Options, [out, report_errors, report_warnings, return_errors,
                  return_warnings, time, verbose, return, report, compile]).

set_options(Opts) when is_list(Opts) ->
    validate_options(proplists:get_keys(Opts)),
    [option(Key, Opts) || Key <- ?Options].

validate_options(Keys) ->
    Valid =  fun(K) ->  lists:member(K, ?Options) end,
    case lists:all(Valid, Keys) of
        true  -> ok;
        false -> throw(badarg)
    end.

option(report, Opts) ->
    case proplists:is_defined(report, Opts) of
        true ->
            Val = proplists:get_bool(report, Opts),
            option(report_errors,   Val),
            option(report_warnings, Val);
        false ->
            ok
    end;
option(return, Opts) ->
    case proplists:is_defined(return, Opts) of
        true ->
            Val = proplists:get_bool(return, Opts),
            option(return_errors,   Val),
            option(return_warnings, Val);
        false ->
            ok
    end;
option(out, Opts) ->
    Out = proplists:get_value(out, Opts, default(out)),
    case proplists:is_defined(return, Opts) of
        true ->
            case is_filename(Out) of
                no       -> throw(badarg);
                Filename -> option(out, Filename)
            end;
        false ->
            set_data(out, Out)
    end;
option(Key, Opts) when is_list(Opts) ->
    set_data(Key, proplists:get_value(Key, Opts, default(Key)));
option(Key, Value) ->
    set_data(Key, Value).

default(out)             -> "";
default(report_errors)   -> true;
default(report_warnings) -> true;
default(return_errors)   -> false;
default(return_warnings) -> false;
default(time)            -> false;
default(verbose)         -> false;
default(compile)         -> false.

%% -----------------------------------------------------------------------------

main(Parent, File) ->
    prepare_filenames(File),
    try prepare_input(),
        try prepare_output(),
            try generate()
            after
                file:close(get_data(outport))
            end
        after
            file:close(get_data(inport))
        end,
        finish()
    catch
        throw:step_failed ->
            ':(';
        throw:{input_error, Reason} ->
            add_error(get_string(infile), none, {file_error, Reason});
        throw:{output_error, Reason} ->
            add_error(get_string(outfile), none, {file_error, Reason}),
            catch file:delete(get_data(outfile));
        exit:Reason ->
            add_error({internal_error, Reason}),
            catch file:delete(get_data(outfile))
    end,
    Parent ! {self(), summary()}.

prepare_filenames(File) ->
    Infile = assure_extension(File, ?ASSUMED_EXTENSION),
    Out = get_data(out),
    OutName = case Out of
                   [] -> filename:rootname(Infile, ?ASSUMED_EXTENSION);
                   _  -> Out
               end,
    Outfile = assure_extension(OutName, ".erl"),
    Module = list_to_atom(filename:basename(Outfile, ".erl")),
    set_data(module,  Module),
    set_data(infile,  Infile),
    set_data(outfile, Outfile).

prepare_input() ->
    case file:open(get_string(infile), [read, read_ahead]) of
        {ok, Inport}    -> set_data(inport, Inport);
        {error, Reason} -> throw({input_error, Reason})
    end.

prepare_output() ->
    case file:open(get_string(outfile), [write, delayed_write]) of
        {ok, Outport}   -> set_data(outport, Outport);
        {error, Reason} -> throw({output_error, Reason})
    end.

finish() ->
    case get_datas(errors) of
        [] -> try2compile();
        _ ->  file:delete(get_string(outfile))
    end.

try2compile() ->
    Pre = fun() ->
                  io:fwrite(<<"Processing the output file ~s\n">>,
                            [format_filename(get_string(outfile))])
          end,
    TF = timing_fun(Pre),
    Ps = [?STEP(check_if_compiles), ?STEP(prettyprint)] ++ 
        [?STEP(compile) || get_data(compile)],
    [run_step(TF, Name, Fun) || {Name, Fun} <- Ps].

timing_fun(Pre) ->
    case get_data(time) of
        true  -> Pre(), fun timeit/2;
        false -> fun(_Name, Fn) -> Fn() end
    end.

run_step(F, Name, Fun) ->
    F(Name, Fun),
    case get_datas(errors) of
        [] -> ok;
        _  -> throw(step_failed)
    end.

generate() ->
    Pre = fun() ->
                  io:fwrite(<<"Generating generators from grammar ~s\n">>,
                            [format_filename(get_string(infile))])
          end,
    TF = timing_fun(Pre),
    Ps =  [?STEP(parse_grammar), ?STEP(check_grammar), ?STEP(write_file)],
    [run_step(TF, Name, Fun) || {Name, Fun} <-Ps].

timeit(Name, Fun) ->
    {Before, _} = statistics(runtime),
    Fun(),
    {After, _} = statistics(runtime),
    Mem0 = ets:info(?ETSTAB, memory)*erlang:system_info(wordsize),
    Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])),
    io:fwrite(" ~-20w- ~11.2f s ~11s\n", [Name, (After-Before)/1000, Mem]).

%% -----------------------------------------------------------------------------
%% Scanning and parsing the grammar definition

parse_grammar() -> parse_grammar(get_data(inport), 1).

parse_grammar(Inport, Line) ->
    {NextLine, Grammar} = read_grammar(Inport, Line),
    parse_grammar(Grammar, Inport, NextLine).

parse_grammar(eof, _Inport, _NextLine) ->
    ok;
parse_grammar({#symbol{name = 'Header'}, Ss}, Inport, NextLine) ->
    set_datalist(header, [S || {string,_,S} <- Ss]),
    parse_grammar(Inport, NextLine);
parse_grammar({#symbol{name = 'Erlang'}, [#symbol{name = code}]}, _Inport,
              NextLine) ->
    set_data(erlang_code, NextLine);
parse_grammar(Grammar, Inport, NextLine) ->
    parse_grammar(Grammar),
    parse_grammar(Inport, NextLine).

parse_grammar({error,ErrorLine,Error}) ->
    add_error(ErrorLine, Error);

parse_grammar({ruleset, LHS, Rules1}) ->
    {Defaults, Rules} = lists:partition(fun is_default_rule/1, Rules1),
    add_data(rules,
             #ruleset{lhs     = LHS,
		      rules   = [get_rule_record(R) || R <- Rules],
		      default = [get_rule_record(D) || D <- Defaults]});
parse_grammar({#symbol{line = Line, name = Name}, Symbols}) ->
    CF = fun(I) ->
                 case get_datas(I) of
                     [] -> add_datas(I, names(Symbols));
                     _  -> add_error(Line, {duplicate_declaration, Name})
                 end
         end,
    case Name of
        'Nonterminals' -> CF(nonterminals);
        'Terminals'    -> CF(terminals);
        'Sized'        -> CF(sized);
        'Recursive'    -> CF(recursive);
        'Guard'        -> CF(guard);
        'Validator'    -> CF(validator);
        'Rootsymbol'   -> CF(rootsymbol);
        _ -> add_warning(Line, bad_declaration)
    end.

is_default_rule({rule, _, _, _RHS=[{{symbol,_,'DEFAULT'},[]}], _, _}) -> true;
is_default_rule(_) -> false. 

get_rule_record({rule, F, G, _RHS=[{{symbol,_,'DEFAULT'},[]}], Tokens, AM}) ->
    #rule{freq = F, guard = G, rhs = ['DEFAULT'], tokens = Tokens, attrmanip = AM};
get_rule_record({rule, F, G, RHS, Tokens, AM}) ->
    #rule{freq = F, guard = G, rhs = RHS, tokens = Tokens, attrmanip = AM};
get_rule_record({rule, F, G, RHS, Tokens, AM, Rule}) ->
    #rule{freq = F, guard = G, rhs = RHS, tokens = Tokens,
          attrmanip = AM, nested = get_rule_record(Rule)}.

read_grammar(Inport, Line) ->
    case egg_scanner:scan(Inport, '', Line) of
        {eof, NextLine} ->
            {NextLine, eof};
        {error, {ErrorLine, Mod, What}, NextLine} ->
            {NextLine, {error, ErrorLine, {error, Mod, What}}};
        {ok, Input, NextLine} ->
            {NextLine, case egg_parse:parse(Input) of
                           {error, {ErrorLine, Mod, Message}} ->
                               {error, ErrorLine, {error, Mod, Message}};
                           {ok, {ruleset, LHS, Rules}} ->
                               {ruleset, LHS, Rules};
                           {ok, Ss} ->
                               Ss
                       end}
    end.

%% -----------------------------------------------------------------------------
%% Checking the grammar

%% TODO Improve the grammar validation, implement more checks

check_grammar() ->
    AllSymbols = get_datas(nonterminals) ++ get_datas(terminals),
    set_datalist(all_symbols, AllSymbols),
    check_nonterminals(),
    check_terminals(),
    check_rootsymbol(),
    check_rules().

check_nonterminals() ->
    case get_datas(nonterminals) of
        [] ->
            add_error(nonterminals_missing);
        Nonterminals ->
            {Unique, Dups} = duplicates(Nonterminals),
            add_warnings(Dups, duplicate_nonterminal),
            set_datalist(nonterminals, Unique)
    end.

check_terminals() ->
    case get_datas(terminals) of
        [] ->
            add_error(terminals_missing);
        Terminals ->
            {Unique, Dups} = duplicates(Terminals),
            add_warnings(Dups, duplicate_terminal),
            Common = intersect(get_datas(nonterminals), Unique),
            add_errors(Common, symbol_terminal_and_nonterminal),
            set_datalist(terminals, Unique)
    end.

check_rootsymbol() ->
    case get_datas(rootsymbol) of
        [] ->
            add_error(rootsymbol_missing);
        SymNames ->
            [case kind_of_symbol(SymName) of
                 nonterminal ->
                     %% set_data(rootsymbol, SymName);
                     ok;
                 _ ->
                     %% Line number?
                     add_error(-1, {bad_rootsymbol, SymName})
             end || SymName <- SymNames]
    end.

check_rules() ->
    case get_datas(rules) of
        [] -> add_error(no_grammar_rules);
        Rs -> [check_ruleset(R) || R <- Rs]
    end.

check_ruleset(RS = #ruleset{lhs = LHS, rules = Rules}) ->
    #symbol{line = HeadLine, name = Head} = generator_sym(LHS),
    case member(Head, get_datas(nonterminals)) of
        false ->
            delete_data(rules, RS),
            add_error(HeadLine, {undefined_nonterminal, Head});
        true ->
            ValidRules = lists:foldl(
              fun(Rule, Rs) ->
                      case check_rule(Rule) of
                          true  -> [Rule|Rs];
                          false -> io:format("Rule dropped: ~p~n", [Rule]), Rs
                      end
              end, [], Rules),
            case usort(Rules) /= usort(ValidRules) of
                true ->
                    %% should give warning (rule alternative dropped)
                    delete_data(rules, RS),
                    add_data(rules, RS#ruleset{rules = ValidRules});
                false ->
                    ok
            end
    end.

check_rule(#rule{rhs = RHS}) ->
    lists:all(fun(X) -> X =:= ok end,
              [check_sym(generator_sym(G)) || {G, _} <- RHS]).

%% TODO: store terminals, nonterminals, and all_symbols as symbol
%% records rather than as atoms

check_sym(Sym) ->
    case member(Sym#symbol.name, get_datas(all_symbols)) of
        true ->
            ok;
        false ->
            E = {undefined_symbol,Sym#symbol.name},
            add_error(Sym#symbol.line, E),
            error
    end.

duplicates(List) ->
    Unique = usort(List),
    {Unique, List -- Unique}.

names(Symbols) -> map(fun(Symbol) -> Symbol#symbol.name end, Symbols).

symbol_line(Name) ->
    {value, #symbol{line = Line}} = symbol_search(Name, get_datas(all_symbols)),
    Line.

symbol_search(Name, Symbols) -> keysearch(Name, #symbol.name, Symbols).

%% -----------------------------------------------------------------------------
%% Writing the output file

write_file() ->
    Rules = get_datas(rules),
    Inport = get_data(inport),
    Outport = get_data(outport),
    output_prelude(Outport, Inport),
    nl(),
    output_rulesets(Rules),
    nl().

output_prelude(Outport, Inport) ->
    output_header(),
    fwrite(<<"-module(~w).\n">>, [get_data(module)]),
    fwrite(<<"-compile([export_all]).\n\n">>, []),
    include("lib/egg/src/egg.hrl", Outport),
    case get_datas(erlang_code) of
        [] -> ok;
        _  -> include2([], Inport, Outport)
    end,
    nl().

output_header() -> [fwrite(<<"~s\n">>, [Str]) || Str <- get_datas(header)].

%% -----------------------------------------------------------------------------
%% Printing the rules as generator functions

output_rulesets(Rules) ->
    Rules1 = lists:map(fun output_ruleset/1, Rules),
    Rules2 = group_rulesets(Rules1),
    Fs = [?S:function(?S:atom(Name), Clauses) || {Name, _A, Clauses} <- Rules2],
    [begin
         fwrite(<<"~s">>, [erl_prettypr:format(F)]), nl(), nl()
     end || F <- Fs].

group_rulesets(Rules) ->
    NamesArities =
        [{Name, lists:usort([Arity || {Name2, Arity, _} <- Rules,
                                      Name2 == Name])} ||
            Name <- lists:usort([Name || {Name, _, _} <- Rules])],
    NA = lists:flatten(
           [lists:zip(lists:duplicate(length(Arities), Name), Arities) ||
               {Name, Arities} <- NamesArities]),
    [{Name, Arity,
      [element(3, R) || R <- Rules,
            element(1, R) == Name,
            element(2, R) == Arity]} ||
        {Name, Arity} <- NA].

output_ruleset(#ruleset{lhs = LHS, rules = Rs, default = []}) ->
    RuleSet = output_ruleset2(#ruleset{lhs = LHS, rules = Rs, default = []}),
    ruleset_clause(LHS, RuleSet);
output_ruleset(#ruleset{lhs = LHS, rules = Rs, default = [Default]}) ->
    {[DR], _} = output_rule(Default, {?S:variable('V0'), 0, 1}),
    Rest = output_ruleset2(#ruleset{lhs = LHS, rules = Rs, default = []}, 2),
    ruleset_clause(LHS, [app(default, [DR] ++ Rest)]).

output_ruleset2(RS) -> output_ruleset2(RS, 1).

output_ruleset2(#ruleset{rules = [Rule], default = []}, J) ->
    output_rules([Rule], J);
output_ruleset2(#ruleset{rules = Rs = [#rule{freq = {}}|_], default = []}, J) ->
    [app(oneof, [app(lists, flatten, [?S:list(output_rules(Rs, J))])])];
output_ruleset2(#ruleset{rules = Rs, default = []}, J) ->
    [app(frequency, [app(lists, flatten, [?S:list(output_rules(Rs, J))])])].

app(FN, Args) -> ?S:application(?S:atom(FN), Args).
app(MN, FN, Args) -> ?S:application(?S:atom(MN), ?S:atom(FN), Args).

ruleset_clause(LHS, Body) ->
    IME = case member(generator_name(LHS), get_datas(rootsymbol)) of
              true -> [?S:match_expr(?S:variable('V0'), ?S:nil())];
              false -> []
          end,
    Body2 = case member(generator_name(LHS), get_datas(recursive))  of
                true -> [?S:macro(?S:text("LAZY"), Body)];
                false -> Body
          end,
    {generator_name(LHS), generator_arity(LHS),
     ?S:clause(generator_args(LHS), none, IME ++ Body2)}.

%% output_rules(Rs) -> output_rules(Rs, 1).

output_rules(Rs, J) ->
    ORs = [output_rule(R, {?S:variable('V0'), 0, I}) ||
              {I, R} <- lists:zip(lists:seq(J, length(Rs)+J-1), Rs)],
    {L, _} = lists:unzip(ORs),
    lists:flatten(L).

output_rule(undefined, {A, VarCnt, I}) -> {[], {A, VarCnt, I}};
output_rule(R, {MainAttrib, VarCnt, I}) ->
    #rule{rhs = RHS, tokens = Tokens, nested = NestedRule, attrmanip = AM} = R,
    {B, OutVarCnt, OutI} =
        case {Tokens, NestedRule, AM} of
            {[], undefined, []} ->
                output_rule(RHS, MainAttrib, VarCnt, I);
            {_, undefined, _} ->
                output_rule(RHS, MainAttrib, VarCnt, I, Tokens, AM);
            {_, _, _} ->
                output_rule(RHS, MainAttrib, VarCnt, I, Tokens, NestedRule, AM)
        end,

    {[add_freq_guard(R, MainAttrib, B)], {MainAttrib, OutVarCnt, OutI}}.

add_freq_guard(#rule{freq = F, guard = G}, MainAttrib, B) ->
    B2 = case F of
             {} -> B;
             {integer, _, I} -> ?S:tuple([?S:integer(I), B])
         end,
    case G of
        {} -> B2;
        _  -> app(include_if, [output_guard(G, MainAttrib), B2])
    end.

output_rule(RHS, MainAttrib, VarCnt, I) ->
    {tuple_or_not([output_generator(G, LAM, MainAttrib) ||
                      {G, LAM} <- RHS]), VarCnt, I}.

output_rule(RHS2, MainAttrib, VarCnt, I, Tokens, AM) ->
    RHS = case RHS2 of
	      ['DEFAULT'] -> [];
	      _ -> RHS2
	  end,
    ValueVar = ?S:variable("R" ++ integer_to_list(I)),
    {AM2, StoreValue} =
        case Tokens of
            [] -> {AM, []};
            _ -> {AM ++ [{{atom, 0, value}, [?S:revert(ValueVar)]}],
                  [?S:match_expr(ValueVar, ?S:block_expr(output_tokens(Tokens)))]}
        end,
    {Vars, NewAttrib} = vars_newattrib(RHS, VarCnt, MainAttrib),
    Modified = output_attrib_modifs(AM2, NewAttrib),
    case RHS2 of
        ['DEFAULT'] -> {?S:block_expr(StoreValue ++ [Modified]),
			VarCnt, I+1};
        [] -> {?S:block_expr(StoreValue ++ [app(return, [Modified])]),
               VarCnt, I+1};
        _ -> output_let(RHS, Vars, ?S:block_expr(StoreValue ++ [Modified]),
                        MainAttrib, -1, -1)
    end.

output_rule(RHS, MainAttrib, VarCnt, I, Tokens, Nested, AM) ->
    ValueVar = ?S:variable("R" ++ integer_to_list(I)),
    {AM2, StoreValue} =
        case Tokens of
            [] -> {AM, []};
            _ -> {AM ++ [{{atom, 0, value}, [?S:revert(ValueVar)]}],
                  [?S:match_expr(ValueVar, ?S:block_expr(output_tokens(Tokens)))]}
        end,
    {Vars, NewAttrib} = vars_newattrib(RHS, VarCnt, MainAttrib),
    Modified = output_attrib_modifs(AM2, NewAttrib),
    TmpAttrib = ?S:variable("S" ++ integer_to_list(VarCnt+length(RHS))),
    StoreATmpAttrib =
        case RHS of
            [] -> [?S:match_expr(TmpAttrib,
                                 output_attrib_modifs(AM, NewAttrib))];
            _ -> [?S:match_expr(TmpAttrib, Modified)]
        end,
    {NestedRule, _} =  output_rule(Nested, {TmpAttrib, VarCnt+length(RHS), I+1}),
    case RHS of
        [] -> {?S:block_expr(output_tokens(Tokens) ++ StoreATmpAttrib
                             ++ NestedRule), VarCnt+2, I+1};
        _ -> output_let(RHS, Vars,
                        ?S:block_expr(StoreValue ++ StoreATmpAttrib ++ NestedRule),
                        MainAttrib, VarCnt+2, I+1)
    end.

vars_newattrib(RHS, VarCnt, Attrib) ->
    L = length(RHS),
    case L of
        0 -> {[], Attrib};
        1 -> [V] = gen_vars(VarCnt, 1),
             {V, V};
        _ ->
            Vs = gen_vars(VarCnt, L),
            Vs2 = [app(inherit, [Z]) || Z <- Vs],
            {?S:tuple(Vs), app(attrmerge, [?S:tuple(Vs2)])}
    end.

output_let(RHS, Vars, Body, MainAttrib, VarCnt, I) ->
    Gens = [output_generator(X, AM, MainAttrib) || {X, AM} <- RHS],
    {?S:macro(?S:text("LET"), [Vars, tuple_or_not(Gens), Body]),
     VarCnt + length(RHS), I}.

%% ============================================================================
%% Compiling the output file

prettyprint() -> erl_tidy:file(get_string(outfile), [{backups, false}]).

check_if_compiles() ->
    case compile:file(get_string(outfile), [strong_validation,return_errors]) of
        {ok, _} ->
            ok;
        Error ->
            add_error(get_string(outfile), none, {cannot_compile_output, Error}),
            error
    end.

compile() ->
    File = get_string(outfile),
    Mod = get_string(module),
    compile:file(File, [report, {outdir, filename:dirname(File)}]),
    code:purge(Mod),
    code:load_file(Mod).

%%% ============================================================================
%%% Returning, errors

summary() ->
    report_errors(),
    report_warnings(),
    Es = pack_errors(get_datas(errors)),
    Ws = pack_warnings(get_datas(warnings)),
    if
        Es =:= [] ->
            case get_data(return_warnings) of
                true  -> {ok, get_string(outfile), Ws};
                false -> {ok, get_string(outfile)}
            end;
        true ->
            case get_data(return_errors) of
                true  -> {error, Es, Ws};
                false -> error
            end
    end.

pack_errors([{File,_} | _] = Es) ->
    [{File, flatmap(fun({_,E}) -> [E] end, sort(Es))}];
pack_errors([]) ->
    [].

pack_warnings([{File,_} | _] = Ws) ->
    [{File, flatmap(fun({_,W}) -> [W] end, sort(Ws))}];
pack_warnings([]) ->
    [].

report_errors() ->
    case get_datas(errors) of
        [] -> ok;
        _ -> io:fwrite(<<"\n">>,[])
    end,
    case get_data(report_errors) of
        true ->
            foreach(fun({File,{none,Mod,E}}) ->
                            io:fwrite(<<"~s: ~s\n">>,
                                      [File,Mod:format_error(E)]);
                       ({File,{Line,Mod,E}}) ->
                            io:fwrite(<<"~s:~w: ~s\n">>,
                                      [File,Line,Mod:format_error(E)])
                    end, sort(get_datas(errors)));
        false ->
            ok
    end.

report_warnings() ->
    case get_datas(warnings) of
        [] -> ok;
        _ -> io:fwrite(<<"\n">>,[])
    end,

    case get_data(report_warnings) of
        true ->
            foreach(fun({File,{none,Mod,W}}) ->
                            io:fwrite(<<"~s: Warning: ~s\n">>,
                                      [File,Mod:format_error(W)]);
                       ({File,{Line,Mod,W}}) ->
                            io:fwrite(<<"~s:~w: Warning: ~s\n">>,
                                      [File,Line,Mod:format_error(W)])
                    end, sort(get_datas(warnings)));
        false ->
            ok
    end.

add_error(E) ->
    add_error(none, E).

add_error(Line, E) ->
    add_error(get_string(infile), Line, E).

add_error(File, Line, E) ->
    add_data(errors, {File,{Line,?MODULE,E}}).

add_errors(SymNames, E0) ->
    [add_error(symbol_line(SymName), {E0, SymName}) || SymName <- SymNames].

add_warning(Line, W) ->
    add_data(warnings, {get_string(infile),{Line,?MODULE,W}}).

add_warnings(SymNames, W0) ->
    [add_warning(symbol_line(SymName), {W0, SymName}) || SymName <- SymNames].

%%% ============================================================================
%%% MISC

kind_of_symbol(SymName) ->
    case member(SymName, get_datas(nonterminals)) of
        false -> case member(SymName, get_datas(terminals)) of
                     false -> unknown;
                     true  -> terminal
                 end;
        true -> nonterminal
    end.

%% is_sized(SymName) -> member(SymName, get_datas(sized)).
%% is_lazy(SymName) -> member(SymName, get_datas(recursive)).
%% is_guard(SymName) -> member(SymName, get_datas(guard)).

intersect(L1, L2) ->
    ordsets:to_list(ordsets:intersection(ordsets:from_list(L1),
                                         ordsets:from_list(L2))).

include(File, Outport) ->
    case file:open(File, [read]) of
        {error, Reason} ->
            throw(add_error(File, none, {file_error, Reason}));
        {ok, Inport} ->
            Line = io:get_line(Inport, ''),
            include2(Line, Inport, Outport),
            file:close(Inport)
    end.

include2(eof, _, _) -> ok;
include2(Line, Inport, Outport) ->
    io:put_chars(Outport, Line),
    include2(io:get_line(Inport, ''), Inport, Outport).

fwrite(Format, Args) -> io:fwrite(get_data(outport), Format, Args).
nl() -> io:nl(get_data(outport)).
format_filename(Filename) -> io_lib:write_string(filename:flatten(Filename)).

format_symbol(Symbol) ->
    String = concat([Symbol]),
    case erl_scan:string(String) of
        {ok, [{atom, _, _}], _} ->
            io_lib:fwrite(<<"~w">>, [Symbol]);
        {ok, [{Word, _}], _} when Word =/= '::', Word =/= '->' ->
            case erl_scan:reserved_word(Word) of
                true ->
                    String;
                false ->
                    io_lib:fwrite(<<"~w">>, [Symbol])
            end;
        {ok, [{var, _, _}], _} ->
            String;
        _ ->
            io_lib:fwrite(<<"~w">>, [Symbol])
    end.

%% -----------------------------------------------------------------------------

generator_name(#symbol{name = N}) -> N;
generator_name({app, N, _}) -> generator_name(N).

generator_arity(#symbol{}) -> 0;
generator_arity({app, _, Args}) -> length(Args).

generator_args(#symbol{name = N}) ->
    case member(N, get_datas(rootsymbol)) of
        true -> [];
        false -> [?S:variable('V0')]
    end;
generator_args({app, N, Args}) ->
    [output_symbol(S) || S <- Args] ++
        case member(generator_name(N), get_datas(rootsymbol)) of
            true -> [];
            false -> [?S:variable('V0')]
        end.

tuple_or_not([E]) -> E;
tuple_or_not(L) when is_list(L) -> ?S:tuple(L).

output_guard(#symbol{name = Name}, MainAttrib) ->
    A2 = case member(Name, get_datas(guard)) of
             true -> [MainAttrib];
             false -> []
         end,
    app(Name, A2);
output_guard({app, #symbol{name = Name}, Args}, MainAttrib) ->
    A2 = case member(Name, get_datas(guard)) of
             true -> [MainAttrib];
             false -> []
         end,
    app(Name, [output_symbol(Arg) || Arg <- Args] ++ A2);
output_guard({LogOp, G1, G2}, MainAttrib) ->
    ?S:infix_expr(output_guard(G1, MainAttrib),
                  ?S:operator(LogOp),
                  output_guard(G2, MainAttrib)).

generator_sym(S = #symbol{}) -> S;
generator_sym({app, S = #symbol{}, _}) -> S;
generator_sym({ind_list, Gen}) -> generator_sym(Gen);
generator_sym({dep_list, Gen}) -> generator_sym(Gen);
generator_sym({ind_list, _, Gen}) -> generator_sym(Gen);
generator_sym({dep_list, _, Gen}) -> generator_sym(Gen).

output_generator(#symbol{name = Name}, AM, MainAttrib) ->
    A2 = case member(Name, get_datas(nonterminals)) of
             true -> [output_attrib_modifs(AM, MainAttrib)];
             false -> []
         end,
    App = app(Name, A2),
    case member(Name, get_datas(terminals)) of
        true -> ?S:macro(?S:text("terminal"),
                         [App, output_attrib_modifs(AM, MainAttrib)]);
        false -> output_validator(app(modif_generator, [App]), AM)
    end;
output_generator({app, #symbol{name = Name}, Args}, AM, MainAttrib) ->
    A2 = case member(Name, get_datas(nonterminals)) of
             true -> [output_attrib_modifs(AM, MainAttrib)];
             false -> []
         end,
    App = app(Name, [output_symbol(Arg) || Arg <- Args] ++ A2),
    case member(Name, get_datas(terminals)) of
        true -> ?S:macro(?S:text("terminal"),
                         [App, output_attrib_modifs(AM, MainAttrib)]);
        false -> output_validator(app(modif_generator, [App]), AM)
    end;
output_generator({ind_list, Gen}, AM, MainAttrib) ->
    output_validator(app(independent_list,
        [?S:fun_expr(
            [?S:clause([?S:variable('Attrs')], none,
                       [output_generator(Gen, [], ?S:variable('Attrs'))])]),
         output_attrib_modifs(AM, MainAttrib)]), AM);
output_generator({dep_list, Gen}, AM, MainAttrib) ->
    output_validator(app(dependent_list,
        [?S:fun_expr(
            [?S:clause([?S:variable('Attrs')], none,
                       [output_generator(Gen, [], ?S:variable('Attrs'))])]),
         output_attrib_modifs(AM, MainAttrib)]), AM);

output_generator({ind_list, Arg, Gen}, AM, MainAttrib) ->
    output_validator(app(independent_list,
        [output_symbol(Arg),
         ?S:fun_expr(
            [?S:clause([?S:variable('Attrs')], none,
                       [output_generator(Gen, [], ?S:variable('Attrs'))])]),
         output_attrib_modifs(AM, MainAttrib)]), AM);
output_generator({dep_list, Arg, Gen}, AM, MainAttrib) ->
    output_validator(app(dependent_list,
        [output_symbol(Arg),
         ?S:fun_expr(
            [?S:clause([?S:variable('Attrs')], none,
                       [output_generator(Gen, [], ?S:variable('Attrs'))])]),
         output_attrib_modifs(AM, MainAttrib)]), AM);

output_generator(X, _, _) -> output_symbol(X).

filter_attrs(AM) ->
    lists:filter(
      fun({{atom, _, validator}, _}) -> false;
         (_) -> true
      end,
      AM).

get_validator(AM) ->
    Vs =
        lists:flatten(
          lists:map(
            fun({{atom, _L, validator}, Code}) -> [{code, Code}];
               (_) -> []
            end,
            AM)),
    case Vs of
        [{code, Code}] ->
            {code, Code};
        _ ->
            no_validator
    end.

output_validator(Gen, AM) ->
    case get_validator(AM) of
        {code, Code} ->
            ?S:macro(?S:text("SUCHTHAT"),
                     [?S:variable('X'),
                      Gen,
                      ?S:application(none,
                                     hd(output_tokens(Code)),
                                     [?S:variable('X')])]);
        no_validator ->
            Gen
    end.

output_attrib_modifs(AM, MainAttrib) ->
    MA = case ?S:type(MainAttrib) of
             variable ->
                 case atom_to_list(?S:variable_name(MainAttrib)) of
                     "Attrs" -> MainAttrib;
                     _ -> app(inherit, [MainAttrib])
                 end;
             _ ->
                 app(inherit, [MainAttrib])
         end,
    lists:foldl(fun output_attrib_modif/2, MA, filter_attrs(AM)).
output_attrib_modif({{atom, _L, Name}, Code}, T) ->
    ?S:macro(?S:text("setattr"),
             [?S:atom(Name), ?S:block_expr(output_tokens(Code)), T]).

output_symbol(#symbol{name = Name}) -> ?S:atom(Name);
output_symbol({integer, _, I})      -> ?S:integer(I);
output_symbol({atom, _, Name})      -> ?S:atom(Name);
output_symbol({var, _, Name})       -> ?S:variable(Name);
output_symbol({app, #symbol{name = FName}, Args}) ->
    app(FName, [output_symbol(Arg) || Arg <- subst_pseudo_vars(Args)]);
output_symbol({macro, #symbol{name = MName}}) ->
    ?S:macro(?S:variable(MName));
output_symbol({macro, #symbol{name = MName}, Args}) ->
    ?S:macro(?S:variable(MName),
             [output_symbol(Arg) || Arg <- subst_pseudo_vars(Args)]);
output_symbol(X = {tree, _, _, _}) ->
    X;
output_symbol(X) ->
    io:format("Unknown symbol: ~p~n", [X]).

output_tokens([]) -> [];
output_tokens(Tokens0) ->
    Tokens = subst_pseudo_vars(Tokens0),
    [?S:text(epp_dodger:tokens_to_string(Tokens))].

%% add_arg_to_app({app, F, Args}, V) -> {app, F, Args ++ [V]};
%% add_arg_to_app(X, _) -> X.


%% -----------------------------------------------------------------------------
%% ETS data storage

extract(X) -> case remove_label(X) of
                  {O} -> O;
                  O -> O
              end.
remove_label(Tuple) -> list_to_tuple(tl(tuple_to_list(Tuple))).
add_label(Label, Tuple) -> list_to_tuple([Label | tuple_to_list(Tuple)]).

get_datas(T) -> [extract(E) || E <- ets:lookup(?ETSTAB, T)].
get_string(T) -> get_data(T).
get_data(T) ->
    case get_datas(T) of
        []  -> none;
        [R] -> R;
        _   -> more
    end.

add_data(X) when is_tuple(X) orelse is_list(X) -> ets:insert(?ETSTAB, X).
add_data(T, X) when is_tuple(X) -> add_data(add_label(T, X));
add_data(T, X) -> add_data({T, X}).
add_datas(T, X) -> [add_data(T, E) || E <- X].

%% set_data(X) when is_tuple(X) -> ets:delete(?ETSTAB, element(1, X)), add_data(X).
set_data(T, X) -> ets:delete(?ETSTAB, T), add_data(T, X).
set_datalist(T, L) -> ets:delete(?ETSTAB, T), add_datas(T, L).
%% set_datalist(L = [E|_]) -> ets:delete(?ETSTAB, element(1, E)), add_data(L).

delete_data(X) when is_tuple(X) orelse is_list(X) -> ets:delete_object(?ETSTAB, X).
delete_data(T, X) when is_tuple(X) -> delete_data(add_label(T, X));
delete_data(T, X) -> delete_data({T, X}).
%% delete_datas(T, X) -> [delete_data(T, E) || E <- X].



%% =============================================================================
%% Misc



is_filename(T) ->
    try filename:flatten(T) of
        Filename -> Filename
    catch
        error:_ -> no
    end.

assure_extension(File, Ext) -> lists:concat([strip_extension(File, Ext), Ext]).

strip_extension(File, Ext) ->
    case filename:extension(File) of
        Ext    -> filename:rootname(File);
        _Other -> File
    end.

gen_vars(C, N) -> gen_vars(C, N, []).
gen_vars(_C, 0, L) -> lists:map(fun ?S:variable/1, L);
gen_vars(C, N, L) -> gen_vars(C, N-1, ["V"++integer_to_list(N+C) | L]).

%% -----------------------------------------------------------------------------
%% Replacing pseudo variables

subst_pseudo_vars([H0 | T0]) ->
    H = subst_pseudo_vars(H0),
    T = subst_pseudo_vars(T0),
    [H | T];
subst_pseudo_vars({atom, Line, Atom}) ->
    case atom_to_list(Atom) of
            [$$ | Rest] ->
                try list_to_integer(Rest) of
                    N when N >= 0 ->
                        {var, Line, list_to_atom(lists:append("V", Rest))};
                    _ ->
                        {atom, Line, 'undefined'}
                catch
                    error: _ -> {atom, Line, Atom}
                end;
            _ ->
                {atom, Line, Atom}
        end;
subst_pseudo_vars(Tuple) when is_tuple(Tuple) ->
    list_to_tuple(subst_pseudo_vars(tuple_to_list(Tuple)));
subst_pseudo_vars(Something_else) ->
    Something_else.
