yecc.erl

OTP是开放电信平台的简称

    {RulesL, _N} = 
        lists:mapfoldl(fun(#rule{symbols = [Nonterminal | Daughters]}, I) ->
                               I1 = I + length(Daughters)+1,
                               {{Nonterminal, I}, I1}
                       end, 1, RulesList),
    IndexedTab = family_with_domain(RulesL, Nonterminals),

    Symbol2Rule = [{Foo,R} || #rule{symbols = Symbols}=R <- RulesListNoCodes,
                              Foo <- Symbols],
    Pointer2Rule = [{I, R} || {{_Foo,R},I} <- count(1, Symbol2Rule)],
    {dict:from_list(IndexedTab), dict:from_list(Pointer2Rule)}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Computing parse action table from list of states and goto table:

compute_parse_actions(N, St, StateActions) ->
    case N < first_state() of
        true -> 
            StateActions;
        false ->
            {N, StateN} = lookup_state(St#yecc.state_tab, N),
            %% There can be duplicates in Actions.
            Actions = compute_parse_actions1(StateN, N, St),
            compute_parse_actions(N - 1, St, [{N, Actions} | StateActions])
    end.

compute_parse_actions1([], _, _) ->
    [];
compute_parse_actions1([#item{rule_pointer = RulePointer, 
                              look_ahead = Lookahead0, 
                              rhs = Rhs} | Items], N, St) ->
    case Rhs of
        [] ->
            Lookahead = decode_terminals(Lookahead0, St#yecc.inv_symbol_tab),
            case rule(RulePointer, St) of
                {[?ACCEPT | _], _RuleLine, _} ->
                    [{Lookahead, accept}
                     | compute_parse_actions1(Items, N, St)];
                %% Head is placed after the daughters when finding the
                %% precedence. This is how giving precedence to
                %% non-terminals takes effect.
                {[Head | Daughters0], _RuleLine, _} ->
                    Daughters = delete('$empty', Daughters0),
                    [{Lookahead,
                      #reduce{rule_nmbr = RulePointer, head = Head, 
                              nmbr_of_daughters = length(Daughters), 
                              prec = get_prec(Daughters ++ [Head], St)}}
                     | compute_parse_actions1(Items, N, St)]
            end;
        [Symbol | Daughters] ->
            case is_terminal(St#yecc.symbol_tab, Symbol) of
                true ->
                    DecSymbol = decode_symbol(Symbol, St#yecc.inv_symbol_tab),
                    {[Head | _], _RuleLine, _} = rule(RulePointer, St),
                    %% A bogus shift-shift conflict can be introduced
                    %% here if some terminal occurs in different rules
                    %% which have been given precedence "one level up".
                    Prec1 = case Daughters of
                                [] -> get_prec([DecSymbol, Head], St);
                                _ -> get_prec([DecSymbol], St)
                            end,
                    Pos = case Daughters of
                              [] -> z;
                              _ -> a
                          end,
                    [{[DecSymbol],
                      #shift{state = goto(N, DecSymbol, St), 
                             pos = Pos,
                             prec = Prec1,
                             rule_nmbr = RulePointer}}
                     | compute_parse_actions1(Items, N, St)];
                false ->
                    compute_parse_actions1(Items, N, St)
            end
    end.

get_prec(Symbols, St) ->
    get_prec1(Symbols, St#yecc.prec_tab, {0, none}).

get_prec1([], _, P) ->
    P;
get_prec1([Symbol | T], PrecTab, P) ->
    case ets:lookup(PrecTab, Symbol) of
        [] ->
            get_prec1(T, PrecTab, P);
        [{_, N, Ass}] ->
            get_prec1(T, PrecTab, {N, Ass})
    end.

create_precedence_table(St) ->
    PrecTab = ets:new(yecc_precedences, []),
    true = ets:insert(PrecTab, St#yecc.prec),
    St#yecc{prec_tab = PrecTab}.
    
-record(cxt, {terminal, state_n, yecc, res}).

%% Detects shift-reduce and reduce-reduce conflicts.
%% Also removes all but one conflicting action. As a consequence the
%% lookahead sets for a state are always disjoint.
%% Reduce/reduce conflicts are considered errors.
find_action_conflicts(St0) ->
    Cxt0 = #cxt{yecc = St0, res = []},
    {#cxt{yecc = St, res = Res}, NewParseActions0} = 
        foldl(fun({N, Actions0}, {Cxt1, StateActions}) ->
                      L = [{Terminal, Act} || {Lookahead, Act} <- Actions0,
                                              Terminal <- Lookahead],
                      {Cxt, Actions} = 
                          foldl(fun({Terminal, As}, {Cxt2,Acts0}) ->
                                        Cxt3 = Cxt2#cxt{terminal = Terminal, 
                                                        state_n = N},
                                        {Action, Cxt} = 
                                            find_action_conflicts2(As, Cxt3),
                                        {Cxt,[{Action,Terminal} | Acts0]}
                                end, {Cxt1,[]}, family(L)),
                      {Cxt,[{N,inverse(family(Actions))} | StateActions]}
              end, {Cxt0, []}, St0#yecc.parse_actions),
    if 
        length(Res) > 0, St#yecc.verbose -> 
            io:fwrite("\n*** Conflicts resolved by operator precedences:\n\n"),
            foreach(fun({Confl, Name}) ->
                            report_conflict(Confl, St, Name, prec)
                    end, reverse(Res)),
            io:fwrite("*** End of resolved conflicts\n\n");
        true -> 
            ok
    end,
    NewParseActions = reverse(NewParseActions0),
    St#yecc{parse_actions = NewParseActions}.

find_action_conflicts2([Action], Cxt) ->
    {Action, Cxt};
find_action_conflicts2([#shift{state = St, pos = Pos, prec = Prec},
                        #shift{state = St}=S | As], 
                       Cxt) when Pos =:= a; Prec =:= {0,none} ->
    %% This is a kludge to remove the bogus shift-shift conflict
    %% introduced in compute_parse_actions1().
    find_action_conflicts2([S | As], Cxt);
find_action_conflicts2([#shift{state = NewState, pos = z}=S1,
                        #shift{state = NewState}=S2 | _], Cxt) ->
    %% This is even worse than last clause. Give up.
    Confl = conflict(S1, S2, Cxt),
    #cxt{yecc = St0} = Cxt,
    St = conflict_error(Confl, St0),
    {S1, Cxt#cxt{yecc = St}}; % return any action
find_action_conflicts2([#shift{prec = {P1, Ass1}}=S | Rs], Cxt0) ->
    {R, Cxt1} = find_reduce_reduce(Rs, Cxt0),
    #cxt{res = Res0, yecc = St0} = Cxt1,
    #reduce{prec = {P2, Ass2}} = R,
    Confl = conflict(R, S, Cxt1),
    if
        P1 > P2 ->
            {S, Cxt1#cxt{res = [{Confl, shift} | Res0]}};
        P2 > P1 ->
            {R, Cxt1#cxt{res = [{Confl, reduce} | Res0]}};
        Ass1 =:= left, Ass2 =:= left ->
            {R, Cxt1#cxt{res = [{Confl, reduce} | Res0]}};
        Ass1 =:= right, Ass2 =:= right ->
            {S, Cxt1#cxt{res = [{Confl, shift} | Res0]}};
        Ass1 =:= nonassoc, Ass2 =:= nonassoc ->
            {nonassoc, Cxt1};
        P1 =:= 0, P2 =:= 0 ->
            report_conflict(Confl, St0, shift, default),
            St = add_conflict(Confl, St0),
            {S, Cxt1#cxt{yecc = St}};
        true ->
            St = conflict_error(Confl, St0),
            {S, Cxt1#cxt{yecc = St}} % return any action
    end;
find_action_conflicts2(Rs, Cxt0) ->
    find_reduce_reduce(Rs, Cxt0).
         
find_reduce_reduce([R], Cxt) ->
    {R, Cxt};
find_reduce_reduce([#reduce{head = Categ1, prec = {P1, _}}=R1, 
                    #reduce{head = Categ2, prec = {P2, _}}=R2 | Rs], Cxt0) ->
    #cxt{res = Res0, yecc = St0} = Cxt0,
    Confl = conflict(R1, R2, Cxt0),
    {R, Res, St} = 
        if
            P1 > P2 ->
                {R1, [{Confl, Categ1} | Res0], St0};
            P2 > P1 ->
                {R2, [{Confl, Categ2} | Res0], St0};
            true ->
                St1 = conflict_error(Confl, St0), 
                {R1, Res0, St1}
        end,
    Cxt = Cxt0#cxt{res = Res, yecc = St},
    find_reduce_reduce([R | Rs], Cxt).

%% Since the lookahead sets are disjoint (assured by
%% find_action_conflicts), the order between actions can be chosen
%% arbitrarily. nonassoc has to come last, though (but is later
%% discarded!).
sort_parse_actions([]) ->
    [];
sort_parse_actions([{N, La_actions} | Tail]) ->
    [{N, sort_parse_actions1(La_actions)} | sort_parse_actions(Tail)].

sort_parse_actions1(LaActions) ->
    As = filter(fun({_LA, A}) -> A =:= accept end, LaActions),
    Ss = filter(fun({_LA, A}) -> is_record(A, shift) end, LaActions),
    Rs = filter(fun({_LA, A}) -> is_record(A, reduce) end, LaActions),
    Ns = filter(fun({_LA, A}) -> A =:= nonassoc end, LaActions),
    As ++ Ss ++ Rs ++ Ns.

conflict_error(Conflict, St0) ->
    St1 = add_conflict(Conflict, St0),
    add_error({conflict, Conflict}, St1).

report_conflict(Conflict, St, ActionName, How) ->
    if
        St#yecc.verbose ->
            io:fwrite("~s\n", [format_conflict(Conflict)]),
            Formated = format_symbol(ActionName),
            case How of 
                prec ->
                    io:fwrite("Resolved in favor of ~s.\n\n", [Formated]);
                default ->
                    io:fwrite("Conflict resolved in favor of ~s.\n\n", 
                              [Formated])
            end;
        true ->
            ok
    end.

add_conflict(Conflict, St) ->
    case Conflict of
        {Symbol, StateN, _, {reduce, _, _, _}} ->
            St#yecc{reduce_reduce = [{StateN,Symbol} |St#yecc.reduce_reduce]};
        {Symbol, StateN, _, {shift, _, _}} ->
            St#yecc{shift_reduce = [{StateN,Symbol} | St#yecc.shift_reduce]};
        {_Symbol, _StateN, {one_level_up, _, _}, _Confl} ->
            St
    end.

conflict(#shift{prec = Prec1, rule_nmbr = RuleNmbr1}, 
         #shift{prec = Prec2, rule_nmbr = RuleNmbr2}, Cxt) ->
    %% Conflict due to precedences "one level up". Kludge.
    #cxt{terminal = Symbol, state_n = N, yecc = St} = Cxt,    
    {_, L1, RuleN1} = rule(RuleNmbr1, St),
    {_, L2, RuleN2} = rule(RuleNmbr2, St),
    Confl = {one_level_up, {L1, RuleN1, Prec1}, {L2, RuleN2, Prec2}},
    {Symbol, N, Confl, Confl};
conflict(#reduce{rule_nmbr = RuleNmbr1}, NewAction, Cxt) ->
    #cxt{terminal = Symbol, state_n = N, yecc = St} = Cxt,
    {R1, RuleLine1, RuleN1} = rule(RuleNmbr1, St),
    Confl = case NewAction of
                #reduce{rule_nmbr = RuleNmbr2} -> 
                    {R2, RuleLine2, RuleN2} = rule(RuleNmbr2, St),
                    {reduce, R2, RuleN2, RuleLine2};
                #shift{state = NewState} ->
                    {shift, NewState, last(R1)}
            end,
    {Symbol, N, {R1, RuleN1, RuleLine1}, Confl}.

format_conflict({Symbol, N, _, {one_level_up, 
                                {L1, RuleN1, {P1, Ass1}}, 
                                {L2, RuleN2, {P2, Ass2}}}}) ->
    S1 = io_lib:fwrite("Conflicting precedences of symbols when "
                       "scanning ~s in state ~w:\n", 
                       [format_symbol(Symbol), N]),
    S2 = io_lib:fwrite("   ~s ~w (rule ~w at line ~w)\n"
                        "      vs.\n",
                       [format_assoc(Ass1), P1, RuleN1, L1]),
    S3 = io_lib:fwrite("   ~s ~w (rule ~w at line ~w)\n", 
                       [format_assoc(Ass2), P2, RuleN2, L2]),
    [S1, S2, S3];
format_conflict({Symbol, N, Reduce, Confl}) ->
    S1 = io_lib:fwrite("Parse action conflict scanning symbol "
                       "~s in state ~w:\n", [format_symbol(Symbol), N]),
    S2 = case Reduce of
             {[HR | TR], RuleNmbr, RuleLine} ->
                 io_lib:fwrite("   Reduce to ~s from ~s (rule ~w at line ~w)\n"
                               "      vs.\n",
                               [format_symbol(HR), format_symbols(TR), 
                                RuleNmbr, RuleLine])
         end,
    S3 = case Confl of 
             {reduce, [HR2|TR2], RuleNmbr2, RuleLine2} ->
                 io_lib:fwrite("   reduce to ~s from ~s (rule ~w at line ~w).",
                               [format_symbol(HR2), format_symbols(TR2), 
                                RuleNmbr2, RuleLine2]);
             {shift, NewState, Sym} ->
                 io_lib:fwrite("   shift to state ~w, adding right sisters to ~s.",
                           [NewState, format_symbol(Sym)])
         end,
    [S1, S2, S3].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Code generation:

%% The version up to and including parsetools-1.3 is called "1.0".
%%
%% "1.1", parsetools-1.4:
%% - the prologue file has been updated;
%% - nonassoc is new;
%% - different order or clauses;
%% - never more than one clause matching a given symbol in a given state;
%% - file attributes relate messages to .yrl file;
%% - actions put in inlined functions;
%% - a few other minor fixes.

-define(CODE_VERSION, "1.1").
-define(YECC_BUG(M, A), 
        append([" erlang:error({yecc_bug,\"",?CODE_VERSION,"\",",
                io_lib:fwrite(M, A), "}).\n\n"])).

%% Returns number of written newlines.
output_header(Outport, Inport, St) when St#yecc.includefile =:= [] ->
    #yecc{infile = Infile, module = Module} = St,
    io:fwrite(Outport, "-module(~w).\n", [Module]),
    io:fwrite(Outport,
              "-export([parse/1, parse_and_scan/1, format_error/1]).\n",
              []),
    {N_lines_1, LastErlangCodeLine} = 
        case St#yecc.erlang_code of 
            none ->
                {0, no_erlang_code};
            Next_line ->
                output_file_directive(St, Infile, Next_line-1),
                Nmbr_of_lines = include1([], Inport, Outport),
                {Nmbr_of_lines + 1, 
                 {last_erlang_code_line, Next_line+Nmbr_of_lines}}
    end,
    io:nl(Outport),
    IncludeFile = 
        filename:join([code:lib_dir(parsetools), "include","yeccpre.hrl"]),
    %% Maybe one could assume there are no warnings in this file.
    output_file_directive(St, IncludeFile, 0),
    N_lines_2 = include(St, IncludeFile, Outport),
    {4 + N_lines_1 + N_lines_2, LastErlangCodeLine};
output_header(Outport, Inport, St) ->
    #yecc{infile = Infile, module = Module, includefile = Includefile} = St,
    io:fwrite(Outport, "-module(~w).\n", [Module]),
    output_file_directive(St, Includefile, 0),
    N_lines_1 = include(St, Includefile, Outport),
    io:nl(Outport),
    case St#yecc.erlang_code of 
        none ->
            {N_lines_1 + 3, no_erlang_code};
        Next_line ->
            output_file_directive(St, Infile, Next_line-1),
            Nmbr_of_lines = include1([], Inport, Outport),
            {Nmbr_of_lines + 1 + N_lines_1 + 3, 
             {last_erlang_code_line, Next_line+Nmbr_of_lines}}
    end.

%% In the following io:fwr