%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.0, (the "License"); you may not use this file except in
%% compliance with the License. You may obtain a copy of the License at
%% http://www.erlang.org/EPL1_0.txt
%% 
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%% 
%% The Original Code is Erlang-4.7.3, December, 1998.
%% 
%% The Initial Developer of the Original Code is Ericsson Telecom
%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
%% Telecom AB. All Rights Reserved.
%% 
%% Contributor(s): ______________________________________.''
%%
%% Copyright (C) 1992, 1996, 1997 Ericsson Telecom, Sweden
%% File: yecc.erl
%% Author: Carl Wilhelm Welin 08/7199581
%% Purpose: Yacc like LALR-1 parser generator for Erlang.
%% Ref: Aho & Johnson: "LR Parsing", ACM Computing Surveys, vol. 6:2, 1974.
%% Auxiliary files: yeccgramm.yrl, yeccparser.erl, yeccpre.hrl, yeccscan.erl.

%% Line number support added to token format and error messages
%% Supports Tobbe's tokenizer
%% Now with improved code generation suggested by rv

%% Generates 'better' internal variable names beginning with "__"  /cww 951206

%% Improved messages about parse action conflicts, and 'Verbose' flag to
%% decide whether to print 'resolved conflicts' messages or not.
%% N.B. this means the optional includefile name has become the *fourth*
%% (optional) parameter to the call to yecc.   /cww 951221
%% 1997-01-27
%% Kenneth Lundin
%% changed to use the platform portable file manipulation functions
%% in new module filename
-module(yecc).
-copyright('Copyright (c) 1991-97 Ericsson Telecom AB').
-vsn('$Revision: /main/release/free/1').
-export([yecc/2, yecc/3, yecc/4, format_error/1, compile/3]).

-include("erl_compile.hrl").

%%%%%%%%%%%%%%%%%%%%%%%%%
% The parser generator:

yecc(Infile, Outfile) ->
    yecc(Infile, Outfile, false, []).

% Verbose = true/false
yecc(Infile, Outfile, Verbose) ->
    yecc(Infile, Outfile, Verbose, []).

yecc(Infilex, Outfilex, Verbose, Includefilex) ->
    statistics(runtime),
    Infile = strip_extension(Infilex,".yrl"),
    Outfile = strip_extension(Outfilex,".erl"),
    Includefile = strip_extension(Includefilex,".hrl"),
    Inport =
	case catch file:open(lists:concat([Infile, ".yrl"]), read) of
	    {error, _} ->
		io:format("Cannot find/read input file ~s!~n",
			  [lists:concat([Infile, ".yrl"])]),
		exit({yecc, bad_input_file});
	    {'EXIT', _} ->
		io:format("Cannot find/read input file ~s!~n",
			  [lists:concat([Infile, ".yrl"])]),
		exit({yecc, bad_input_file});
	    {ok, Inport1} ->
		io:format("Parsing input file ...~n", []),
		Inport1
	end,
    case parse_grammar(Inport, Infile, 1, [], [], [], [], [], ok) of
	error ->
	    file:close(Inport),
	    exit({yecc, syntax_error});
	Grammar ->
	    Nonterminals =
		case lists:keysearch('Nonterminals', 1, Grammar) of
		    false ->
			exit({yecc, nonterminals_missing});
		    {value, {_, Nonterminals1}} ->
			['ACCEPT' | Nonterminals1]
		end,
	    Terminals =
		case lists:keysearch('Terminals', 1, Grammar) of
		    false ->
			exit({yecc, terminals_missing});
		    {value, {_, Terminals1}} ->
			case intersect(Nonterminals, Terminals1) of
			    [] ->
				['$empty' | Terminals1];
			    _ ->
				exit({yecc, terminals_and_nonterminals_in_common})
			end
		end,
	    Rootsymbol =
		case lists:keysearch('Rootsymbol', 1, Grammar) of
		    false ->
			exit({yecc, rootsymbol_missing});
		    {value, {_, [Rootsymbol1]}} ->
			case lists:member(Rootsymbol1, Nonterminals) of
			    false ->
				exit({yecc, bad_rootsymbol});
			    true ->
				Rootsymbol1
			end
		end,
	    Endsymbol =
		case lists:keysearch('Endsymbol', 1, Grammar) of
		    false ->
			'$end';
		    {value, {_, [Endsymbol1]}} ->
			case lists:member(Endsymbol1, Nonterminals) of
			    false ->
				case lists:member(Endsymbol1, Terminals) of
				    false ->
					Endsymbol1;
				    true ->
					exit({yecc, endsymbol_is_a_terminal})
				end;
			    true ->
				exit({yecc, endsymbol_is_a_nonterminal})
			end
		end,
	    Rules =
		case lists:keysearch('Rules', 1, Grammar) of
		    false ->
			exit({yecc, no_grammar_rules});
		    {value, {_, Rules1}} ->
			[{['ACCEPT', Rootsymbol], {form, []}}
			 | Rules1]
		end,
	    check_missing_rules(Nonterminals, Rules),
	    check_unused_terminals(Terminals, Rules),
	    Precedences =
		case lists:keysearch('Precedences', 1, Grammar) of
		    false ->
			[];
		    {value, {_, Prec}} ->
			Prec
		end,
	    io:format("Computing states and goto table ...~n", []),
	    {States, Goto} =
		compute_states(Nonterminals, [Endsymbol | Terminals],
			       Rootsymbol, Endsymbol, Rules),
	    io:format("Computing parse actions ...~n", []),
	    Parse_actions = compute_parse_actions(States, Goto,
						  [Endsymbol | Terminals],
						  Rules, Precedences),
	    case find_action_conflicts(Parse_actions, [Endsymbol | Terminals],
				       Rules, Verbose, ok) of
		error ->
		    exit({yecc, grammar_not_lalr});
		ok ->
		    Sorted = sort_parse_actions(Parse_actions),
		    Outport =
			case catch file:open(lists:concat([Outfile, ".erl"]),
					     write) of
			    {error, _} ->
				io:format("Cannot open/write file ~s!~n",
					  [lists:concat([Outfile, ".erl"])]),
				exit({yecc, bad_output_file});
			    {'EXIT', _} ->
				io:format("Cannot open/write file ~s!~n",
					  [lists:concat([Outfile, ".erl"])]),
				exit({yecc, bad_output_file});
			    {ok, Outport1} ->
				io:format("Writing file ...~n", []),
				Outport1
			end,
		    io:format(Outport, "-module(~s).~n",
			      [filename:basename(Outfile)]),
		    if
			Includefile == [] ->
			    io:format(Outport,
				      "-define(THIS_MODULE, ~s).~n",
				      [filename:basename(Outfile)]),
			    io:format(Outport,
     "-export([parse/1, parse_and_scan/1, format_error/1]).~n",
				      []),
			    case lists:keysearch('Erlang', 1, Grammar) of
				{value, {_, code}} ->
				    include1([], Inport, Outport);
				_ ->
				    do_nothing
			    end,
			    io:nl(Outport),
			    include(lists:concat([code:lib_dir(parsetools),
						  "/include/yeccpre.hrl"]),
				    Outport);
			true ->
			    include(lists:concat([Includefile, ".hrl"]),
				    Outport),
			    io:nl(Outport),
			    case lists:keysearch('Erlang', 1, Grammar) of
				{value, {_, code}} ->
				    include1([], Inport, Outport);
				_ ->
				    do_nothing
			    end
		    end,
		    file:close(Inport),
		    io:nl(Outport),
		    output_parse_actions(Outport, Sorted, Rules, Goto),
		    output_goto(Outport, Nonterminals, Goto),
		    io:nl(Outport),
		    file:close(Outport),
		    io:format("~s.erl~n", [Outfile]),
		    statistics(runtime)
	    end
    end.

parse_grammar(Inport, Infile, Line, Nonterminals, Prec, Allsymbols, Result, Rules, Flag) ->
    case yeccscan:scan(Inport, '', Line) of
	{eof, _} ->
	    if
		Flag == error ->
		    error;
		true ->
		    [{'Precedences', Prec}, {'Rules', lists:reverse(Rules)}
		     | Result]
	    end;
	{error, {Error_line, Mod, What}, Next_line} ->
	    io:format("~s.yrl:~w: ~s scanning input.~n",
		      [Infile, Error_line, apply(Mod, format_error, [What])]),
	    parse_grammar(Inport, Infile, Next_line, Nonterminals,
			  Prec, Allsymbols, Result, Rules, error);
	{ok, Input, Next_line} ->
	    case yeccparser:parse(Input) of
		{error, {Error_line, Mod, Message}} ->
		    report_error(Infile, Error_line,
				 apply(Mod, format_error, [Message])),
		    parse_grammar(Inport, Infile, Next_line, Nonterminals, Prec,
				  Allsymbols, Result, Rules, error);
		{ok, {rule, Rule, {erlang_code, Tokens}}} ->
		    case lists:member(hd(Rule), Nonterminals) of
			false ->
			    report_error(Infile, Line,
					  lists:concat(["undefined nonterminal: ",
							hd(Rule)])),
			    parse_grammar(Inport, Infile, Next_line, Nonterminals, Prec,
					  Allsymbols, Result, Rules, error);
			true ->
			    case check_rhs(tl(Rule), Allsymbols) of
				undef_symbols ->
				    report_error(Infile, Line,
						  "undefined rhs symbol(s) in rule:"),
				    print_rule(Rule),
				    io:nl(),
				    parse_grammar(Inport, Infile, Next_line,
						  Nonterminals,
						  Prec, Allsymbols, Result,
						  Rules, error);
				illegal_empty ->
				    report_error(Infile, Line,
						  "yecc: illegal use of empty symbol in rhs of rule:"),
				    print_rule(Rule),
				    io:nl(),
				    parse_grammar(Inport, Infile, Next_line,
						  Nonterminals,
						  Prec, Allsymbols, Result,
						  Rules, error);
				ok ->
				    Nmbr_of_daughters =
					case Rule of
					    [_, '$empty']  ->
						0;
					    _ ->
						length(Rule) - 1
					end,
				    Tokens1 =
					subst_dollar_vars(Tokens,
							  Nmbr_of_daughters,
							  Rule),
				    case catch erl_parse:parse_exprs(add_roberts_dot(Tokens1, 0)) of
					{error, {Error_line, Mod, What}} ->
					    report_error(Infile, Error_line,
							 apply(Mod,
							       format_error,
							       [What])),
					    io:format("Bad Erlang code following yecc rule:~n",
						      []),
					    print_rule(Rule),
					    io:nl(),
					    parse_grammar(Inport, Infile,
							  Next_line, 
							  Nonterminals,
							  Prec,
							  Allsymbols,
							  Result,
							  Rules, error);
					{ok, Exprs} ->
					    parse_grammar(Inport, Infile,
							  Next_line, 
							  Nonterminals,
							  Prec,
							  Allsymbols,
							  Result,
							  [{Rule, Exprs} | Rules],
							  Flag);
					{'EXIT', _} ->
					    io:format("Bad Erlang code following rule~n",
						      []),
					    print_rule(Rule),
					    io:format("here:~n~w~n", [Tokens]),
					    parse_grammar(Inport, Infile,
							  Next_line,
							  Nonterminals,
							  Prec,
							  Allsymbols,
							  Result,
							  Rules, error)
				    end
			    end
		    end;
		{ok, {'Nonterminals', Symbols}} ->
		    parse_grammar(Inport, Infile, Next_line, Symbols, Prec,
				  Allsymbols,
				  [{'Nonterminals', Symbols} | Result],
				  Rules, Flag);
		{ok, {'Left', [N, Op]}} ->
		    parse_grammar(Inport, Infile, Next_line, Nonterminals,
				  [{Op, N, left} | Prec], Allsymbols, Result,
				  Rules, Flag);
		{ok, {'Unary', [N, Op]}} ->
		    parse_grammar(Inport, Infile, Next_line, Nonterminals,
				  [{Op, N, unary} | Prec],
				  Allsymbols, Result, Rules, Flag);
		{ok, {'Right', [N, Op]}} ->
		    parse_grammar(Inport, Infile, Next_line, Nonterminals,
				  [{Op, N, right} | Prec], Allsymbols, Result,
				  Rules, Flag);
		{ok, {'Terminals', Symbols}} ->
		    if
			Nonterminals == [] ->
			    io:format("Terminals defined before nonterminals.~n",
				      []),
			    parse_grammar(Inport, Infile, Next_line, [], Prec,
					  Symbols,
					  [{'Terminals', Symbols} | Result],
					  Rules, error);
			true ->
			    parse_grammar(Inport, Infile, Next_line,
					  Nonterminals, Prec,
					  ['$empty'
					   | lists:append(Nonterminals, Symbols)],
					  [{'Terminals', Symbols} | Result],
					  Rules, Flag)
		    end;
		{ok, {'Erlang', [code]}} ->
		    if
			Flag == error ->
			    error;
			true ->
			    [{'Erlang', code},
			     {'Precedences', Prec},
			     {'Rules', lists:reverse(Rules)}
			     | Result]
		    end;
		{ok, Other} ->
		    parse_grammar(Inport, Infile, Next_line, Nonterminals,
				  Prec, Allsymbols,
				  [Other | Result], Rules, Flag)
	    end
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% convert to atom to string if necessary

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

add_roberts_dot([], Line) ->
    [{'dot', Line}];
add_roberts_dot([{'dot', Line} | _], _) ->
    [{'dot', Line}];
add_roberts_dot([Token | Tokens], _) ->
    [Token | add_roberts_dot(Tokens, element(2, Token))].

report_error(Source_file, Line, Message) ->
    io:format("~s", [lists:concat([Source_file, ":", Line, ": ",
				   format_error(Message), "\n"])]).

format_error(Message) ->
    case io_lib:deep_char_list(Message) of
	true ->
	    Message;
	_ ->
	    io_lib:write(Message)
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

check_missing_rules([], _) ->
    ok;
check_missing_rules([Nt | Nts], Rules) ->
    case check_missing_rules1(Rules, Nt) of
	ok ->
	    check_missing_rules(Nts, Rules);
	_ ->
	    io:format("*** Warning: no syntax rule for nonterminal symbol '~w'!~n", [Nt]),
	    check_missing_rules(Nts, Rules)
    end.

check_missing_rules1([], _) ->
    not_ok;
check_missing_rules1([{[Nt | _], _} | _], Nt) ->
    ok;
check_missing_rules1([_ | Rules], Nt) ->
    check_missing_rules1(Rules, Nt).

check_unused_terminals([], _) ->
    ok;
check_unused_terminals([T | Ts], Rules) ->
    case check_unused_terminals1(Rules, T) of
	ok ->
	    check_unused_terminals(Ts, Rules);
	_ ->
	    io:format("*** Warning: terminal symbol '~w' not used!~n", [T]),
	    check_unused_terminals(Ts, Rules)
    end.

check_unused_terminals1(_, '$empty') ->
    ok;
check_unused_terminals1([], _) ->
    not_ok;
check_unused_terminals1([{[_ | Daughters], _} | Rules], Terminal) ->
    case lists:member(Terminal, Daughters) of
	true ->
	    ok;
	_ ->
	    check_unused_terminals1(Rules, Terminal)
    end.

check_rhs(['$empty'], Allsymbols) ->
    case lists:member('$empty', Allsymbols) of
	true ->
	    ok;
	false ->
	    undef_symbols
    end;
check_rhs(Rhs, Allsymbols) ->
    case lists:member('$empty', Rhs) of
	true ->
	    illegal_empty;
	false ->
	    case subset(Rhs, Allsymbols) of
		true ->
		    ok;
		false ->
		    undef_symbols
	    end
    end.

subst_dollar_vars([], _, _) ->
    [];
subst_dollar_vars([H | T], Nmbr_of_daughters, Rule) ->
    [subst_dollar_vars(H, Nmbr_of_daughters, Rule)
     | subst_dollar_vars(T, Nmbr_of_daughters, Rule)];
subst_dollar_vars({atom, Pos, Atom}, Nmbr_of_daughters, Rule) ->
    case atom_to_list(Atom) of
	[$$ | Rest] ->
	    case catch list_to_integer(Rest) of
		{_, _} ->
		    {atom, Pos, Atom};
		N when N > 0, N =< Nmbr_of_daughters ->
		    {var, Pos, list_to_atom(lists:append("__", Rest))};
		_ ->
		    io:format("!!! Warning: Constituent variable ~w undefined in rule~n",
			      [Atom]),
		    print_rule(Rule),
		    {atom, Pos, '$undefined'}
	    end;
	_ ->
	    {atom, Pos, Atom}
    end;
subst_dollar_vars(Tuple, Nmbr_of_daughters, Rule) when tuple(Tuple) ->
    list_to_tuple(subst_dollar_vars(tuple_to_list(Tuple), Nmbr_of_daughters,
				    Rule));
subst_dollar_vars(Something_else, _, _) ->
    Something_else.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Computing parse states and goto table from grammar.
% Start item: {0 bor 1, [Endsymbol], [Rootsymbol]} ==
% (['ACCEPT', '.', Rootsymbol], {'$'}) in Aho & Johnson
% where '$end' is the default end of input symbol of the
% scanner if no 'Endsymbol' has been declared in the syntax file.

compute_states(Nonterminals, Terminals, Rootsymbol, Endsymbol, Rules) ->
    Indexed_rules = make_rule_index(Nonterminals, Rules),
    Lc_table = make_left_corner_table(Nonterminals, Terminals, Rules),
    Start_item = {1, [Endsymbol], [Rootsymbol]},
    State0 = compute_closure([Start_item], [Start_item], Terminals,
			     Indexed_rules, Lc_table),
    compute_states1([{0, get_current_symbols(State0)}],
		    [{0, State0}], [], Terminals, Indexed_rules, Lc_table).

compute_states1([], States, Goto, _, _, _) ->
    {lists:reverse(States), lists:reverse(Goto)};
compute_states1([{N, Symbols} | Try], States, Goto, Terminals, Rules,
		Lc_table) ->
    case lists:keysearch(N, 1, States) of
	{value, {N, S}} ->
	    compute_states2(Symbols, N, S, Try, States, Goto, Terminals, Rules,
			    Lc_table);
	false ->
	    exit({yecc, error})
    end.

compute_states2([], _, _, Try, States, Goto, Terminals, Rules, Lc_table) ->
    compute_states1(Try, States, Goto, Terminals, Rules, Lc_table);
compute_states2([Sym | Syms], N, S, Try, States, Goto, Terminals,
		Rules, Lc_table) ->
    New_state =
	compute_state(S, Sym, [], Terminals, Rules, Lc_table),
    if
	New_state == [] ->
	    compute_states2(Syms, N, S, Try, States, Goto,
			    Terminals, Rules, Lc_table);
	true ->
	    case check_state(New_state, States) of
		{old, M} ->
%		    io:format("Identical to old state ~w~n", [M]),
		    compute_states2(Syms, N, S, Try, States,
				    add_if_not_there({N, Sym, M}, Goto),
				    Terminals, Rules, Lc_table);
		add ->
		    [{M, _} | _] = States,
%		    io:format("Adding state ~w~n", [M + 1]),
		    Current_symbols = get_current_symbols(New_state),
		    compute_states2(Syms, N, S,
				    [{M + 1, Current_symbols} | Try],
				    [{M + 1, New_state} | States],
				    [{N, Sym, M + 1} | Goto],
				    Terminals, Rules, Lc_table);
		{merge, M, Change_list} ->
%		    io:format("Merging with state ~w~n", [M]),
		    New_current = ord_unique(lists:sort(Change_list)),
		    Try1 = case lists:keysearch(M, 1, Try) of
			       false ->
				   [{M, New_current} | Try];
			       {value, {_, Old_current}} ->
				   case ord_subset(New_current, Old_current) of
				       true ->
					   Try;
				       false ->
					   [{M, ord_merge(New_current, Old_current)}
					    | lists:keydelete(M, 1, Try)]
				   end
			   end,
		    compute_states2(Syms, N, S, Try1,
				    merge_states(New_state, States, M),
				    add_if_not_there({N, Sym, M}, Goto),
				    Terminals, Rules, Lc_table)
	    end
    end.

get_current_symbols(State) ->
    ord_unique(lists:sort(get_current_symbols1(State))).

get_current_symbols1([]) ->
    [];
get_current_symbols1([{_, _, Rhs} | Items]) ->
    case Rhs of
	[] ->
	    get_current_symbols1(Items);
	[Symbol | _] ->
	    [Symbol | get_current_symbols1(Items)]
    end.

compute_state([], _, New_state, Terminals, Rules, Lc_table) ->
    lists:keysort(1, compute_closure(New_state, New_state, Terminals, Rules,
				     Lc_table));
compute_state([{Rule_pointer, Lookahead, Rhs} | Items], Symbol, New_state,
	      Terminals, Rules, Lc_table) ->
    case Rhs of
	[] ->
	    compute_state(Items, Symbol, New_state, Terminals, Rules, Lc_table);
	[Symbol | Rhs1] ->
	    compute_state(Items, Symbol,
			  [{Rule_pointer + 1, Lookahead, Rhs1} | New_state],
			  Terminals, Rules, Lc_table);
	_ ->
	    compute_state(Items, Symbol, New_state, Terminals, Rules, Lc_table)
    end.

compute_closure([], State, _, _, _) ->
    State;
compute_closure([{Rule_pointer, Lookahead, Rhs} | Items], State,
		Terminals, Rules, Lc_table) ->
    case Rhs of
	[] ->
	    compute_closure(Items, State, Terminals, Rules, Lc_table);
	[Category | Followers] ->
	    case lists:keysearch(Category, 1, Rules) of
		{value, {_, Expanding_rules}} ->
		    New_lookahead = compute_lookahead(Followers, Lookahead,
						      Terminals, Lc_table),
		    compute_closure1(Expanding_rules, New_lookahead,
				     Items, State, Terminals, Rules, Lc_table);
		false ->
		    compute_closure(Items, State, Terminals, Rules, Lc_table)
	    end
    end.

compute_closure1([], _, Items, State, Terminals, Rules, Lc_table) ->
    compute_closure(Items, State, Terminals, Rules, Lc_table);
compute_closure1([{Rule_nmbr, Rule} | Tail], New_lookahead, Items,
		 State, Terminals, Rules, Lc_table) ->
    {Rule_pointer, Rhs} = case Rule of
			      [_ , '$empty' | Rhs0] ->
				  {Rule_nmbr bor 2, Rhs0};
			      [_ | Rhs0] ->
				  {Rule_nmbr bor 1, Rhs0}
			  end,
    case check_item(Rule_pointer, State, New_lookahead) of
	old ->
	    compute_closure1(Tail, New_lookahead, Items, State,
			     Terminals, Rules, Lc_table);
	add ->
	    New_item = {Rule_pointer, New_lookahead, Rhs},
	    compute_closure1(Tail, New_lookahead, [New_item | Items],
			     [New_item | State], Terminals, Rules, Lc_table);
	merge ->
	    compute_closure1(Tail, New_lookahead,
			     [{Rule_pointer, New_lookahead, Rhs} | Items],
			     merge_items(Rule_pointer, State, New_lookahead),
			     Terminals, Rules, Lc_table)
    end.

check_item(Rule_pointer, [{Rule_pointer, Lookahead2, _} | _], Lookahead1) ->
    case ord_subset(Lookahead1, Lookahead2) of
	true ->
	    old;
	false ->
	    merge
    end;
check_item(Rule_pointer, [_ | Items], Lookahead) ->
    check_item(Rule_pointer, Items, Lookahead);
check_item(_, [], _) ->
    add.

merge_items(Rule_pointer, [{Rule_pointer, Lookahead1, Rhs} | Items],
	    Lookahead2) ->
    [{Rule_pointer, ord_merge(Lookahead1, Lookahead2), Rhs} | Items];
merge_items(Rule_pointer, [Item | Items], Lookahead) ->
    [Item | merge_items(Rule_pointer, Items, Lookahead)].


check_state(New_state, [{M, State} | States]) ->
    case catch check_state1(New_state, State) of
	old ->
	    {old, M};
	add ->
	    check_state(New_state, States);
	Change_list ->
	    {merge, M, Change_list}
    end;
check_state(New_state, []) ->
    add.

check_state1([{Rule_pointer, Lookahead1, Rhs} | Items1],
	     [{Rule_pointer, Lookahead2, _} | Items2]) ->
    case ord_subset(Lookahead1, Lookahead2) of
	true ->
	    check_state1(Items1, Items2);
	false ->
	    case Rhs of
		[] ->
		    check_state2(Items1, Items2);
		[Symbol | _] ->
		    [Symbol | check_state2(Items1, Items2)]
	    end
    end;
check_state1([], []) ->
    old;
check_state1(_, _) ->
    throw(add).

check_state2([{Rule_pointer, Lookahead1, Rhs} | Items1],
	     [{Rule_pointer, Lookahead2, _} | Items2]) ->
    case ord_subset(Lookahead1, Lookahead2) of
	true ->
	    check_state2(Items1, Items2);
	false ->
	    case Rhs of
		[] ->
		    check_state2(Items1, Items2);
		[Symbol | _] ->
		    [Symbol | check_state2(Items1, Items2)]
	    end
    end;
check_state2([], []) ->
    [];
check_state2(_, _) ->
    throw(add).

merge_states(New_state, [{M, Old_state} | States], M) ->
    [{M, merge_states1(New_state, Old_state)} | States];
merge_states(New_state, [Old_state | States], M) ->
    [Old_state | merge_states(New_state, States, M)].

merge_states1([Item1 | Items1], [Item2 | Items2]) when element(2, Item1) == element(2, Item2) ->
    [Item1 | merge_states1(Items1, Items2)];
merge_states1([{Rule_pointer, Lookahead1, Rhs} | Items1],
	      [{_, Lookahead2, _} | Items2]) ->
    [{Rule_pointer, ord_merge(Lookahead1, Lookahead2), Rhs}
     | merge_states1(Items1, Items2)];
merge_states1([], []) ->
    [].


% Lookahead computation is complicated by the possible existence
% of null string rewriting rules, such as  A -> '$empty'.
compute_lookahead([], Old_lookahead, _, _) ->
    Old_lookahead;
compute_lookahead(['$empty' | Followers], Old_lookahead, Terminals, Lc_table) ->
    compute_lookahead(Followers, Old_lookahead, Terminals, Lc_table);
compute_lookahead([Symbol | Symbols], Old_lookahead, Terminals, Lc_table) ->
    case lists:member(Symbol, Terminals) of
	true ->
	    [Symbol];
	false ->
	    case lists:keysearch(Symbol, 1, Lc_table) of
		{value, {Symbol, ['$empty' | Left_corners]}} ->
		    ord_merge(Left_corners,
			      compute_lookahead(Symbols, Old_lookahead,
						Terminals, Lc_table));
		{value, {Symbol, Left_corners}} ->
		    Left_corners;
		false ->
		    exit({Symbol, missing_in_left_corner_table})
	    end
    end.

make_left_corner_table([], _, _) ->
    [];
make_left_corner_table([Nonterminal | Tail], Terminals, Rules) ->
    [{Nonterminal,
      find_left_corners(Rules, Rules, [Nonterminal], Terminals,
			[[Nonterminal]], [], [])}
     | make_left_corner_table(Tail, Terminals, Rules)].

% Which are the possible lower left corner terminals of a (sub)tree
% dominated by a given head/root symbol?
find_left_corners([], _, _, _, _, Found2, []) ->
    case lists:member('$empty', Found2) of
	true ->
	    ['$empty' | lists:sort(lists:delete('$empty', Found2))];
	false ->
	    lists:sort(Found2)
    end;
find_left_corners([], Rules, _, Terminals, Found1, Found2, [First | Rest]) ->
    find_left_corners(Rules, Rules, First, Terminals, Found1, Found2, Rest);
find_left_corners([{[Head | Rhs], _} | Tail], Rules, [Head | Sisters],
		  Terminals, Found1, Found2, Try) ->
    Expansion = case Rhs of
		    ['$empty'] ->
			if
			    Sisters == [] ->
				['$empty'];
			    true ->
				Sisters
			end;
		    [Symbol1] ->
			[Symbol1 | Sisters];
		    _ ->
			case find_prefix(Rhs, Found1) of
			    true ->
				[];
			    false ->
				lists:append(Rhs, Sisters)
			end
		end,
    case Expansion of
	[] ->
	    find_left_corners(Tail, Rules, [Head | Sisters], Terminals, Found1,
			      Found2, Try);
	[Symbol2 | Symbols] ->
	    case lists:member(Symbol2, Terminals) of
		true ->
		    find_left_corners(Tail, Rules, [Head | Sisters], Terminals,
				      Found1,
				      add_if_not_there(Symbol2, Found2), Try);
		false ->
		    case lists:member(Expansion, Found1) of
			true ->
			    find_left_corners(Tail, Rules, [Head | Sisters],
					      Terminals, Found1, Found2, Try);
			false ->
			    find_left_corners(Tail, Rules, [Head | Sisters],
					      Terminals, [Expansion | Found1],
					      Found2, [Expansion | Try])
		    end
	    end
    end;
find_left_corners([_ | Tail], Rules, Followers, Terminals, Found1, Found2, Try) ->
    find_left_corners(Tail, Rules, Followers, Terminals, Found1, Found2, Try).

find_prefix(X, []) ->
    false;
find_prefix(X, [H | T]) ->
    case lists:prefix(X, H) of
	true ->
	    true;
	false ->
	    find_prefix(X, T)
    end.


% Which grammar rules can be used to expand a given non terminal symbol?
make_rule_index([], _) ->
    [];
make_rule_index([Nonterminal | Tail], Rules) ->
    [{Nonterminal, make_rule_index1(Rules, Nonterminal, 0)}
     | make_rule_index(Tail, Rules)].

make_rule_index1([], _, _) ->
    [];
make_rule_index1([{[Nonterminal | Daughters], _} | Rules], Nonterminal, N) ->
    [{N, [Nonterminal | Daughters]}
     | make_rule_index1(Rules, Nonterminal, N + 256)];
make_rule_index1([_ | Rules], Nonterminal, N) ->
    make_rule_index1(Rules, Nonterminal, N + 256).


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

compute_parse_actions([], _, _, _, Prec) ->
    [];
compute_parse_actions([{N, StateN} | States], Goto, Terminals, Rules, Prec) ->
    [{N, compute_parse_actions1(StateN, N, Goto, Terminals, Rules, Prec)}
     | compute_parse_actions(States, Goto, Terminals, Rules, Prec)].

compute_parse_actions1([], _, _, _, _, _) ->
    [];
compute_parse_actions1([{Rule_pointer, Lookahead, Rhs} | Items], N, Goto,
		       Terminals, Rules, Prec) ->
    case Rhs of
	[] ->
	    case rule(Rule_pointer bsr 8, Rules) of
		['ACCEPT' | _] ->
		    [{Lookahead, accept}
		     | compute_parse_actions1(Items, N, Goto, Terminals,
					      Rules, Prec)];
		[Head , '$empty'] ->
		    [{Lookahead,
		      {reduce, Rule_pointer bsr 8, Head, 0, {0, none}}}
		     | compute_parse_actions1(Items, N, Goto, Terminals,
					      Rules, Prec)];
		[Head | Daughters] ->
		    [{Lookahead,
		      {reduce, Rule_pointer bsr 8, Head, length(Daughters),
		       get_prec(Daughters, Prec)}}
		     | compute_parse_actions1(Items, N, Goto, Terminals,
					      Rules, Prec)]
	    end;
	[Symbol | _] ->
	    case lists:member(Symbol, Terminals) of
		true ->
		    Prec1 = case rule(Rule_pointer bsr 8, Rules) of
				[Head, Symbol] ->
				    get_prec([Head, Symbol], Prec);
				_ ->
				    get_prec([Symbol], Prec)
			    end,
		    [{[Symbol], {shift, goto(N, Symbol, Goto), Prec1}}
		     | compute_parse_actions1(Items, N, Goto, Terminals,
					      Rules, Prec)];
		false ->
		    compute_parse_actions1(Items, N, Goto, Terminals, Rules,
					   Prec)
	    end
    end.

get_prec(Symbols, Precedences) ->
    get_prec1(Symbols, Precedences, {0, none}).

get_prec1([], _, P) ->
    P;
get_prec1([H | T], Precedences, P) ->
    case lists:keysearch(H, 1, Precedences) of
	false ->
	    get_prec1(T, Precedences, P);
	{value, {_, N, Ass}} ->
	    get_prec1(T, Precedences, {N, Ass})
    end.

goto(N, Symbol, []) ->
    exit({yecc, N, Symbol, error_in_goto_table});
goto(N, Symbol, [{N, Symbol, To_state} | _]) ->
    To_state;
goto(N, Symbol, [_ | Table]) ->
    goto(N, Symbol, Table).

% To detect shift-reduce, and reduce-reduce conflicts
find_action_conflicts([], _, _, _, Error_flag) ->
    Error_flag;
find_action_conflicts([{N, Actions} | Tail], Terminals, Rules, Verbose,
		      Error_flag) ->
    Flag1 = find_action_conflicts1(Terminals, N, Actions, Rules, Verbose,
				   Error_flag),
    find_action_conflicts(Tail, Terminals, Rules, Verbose, Flag1).

find_action_conflicts1([], _, _, _, _, Error_flag) ->
    Error_flag;
find_action_conflicts1([T | Terminals], N, Actions, Rules, Verbose,
		       Error_flag) ->
    Flag1 = find_action_conflicts2(Actions, T, N, [], Rules, Verbose,
				   Error_flag),
    find_action_conflicts1(Terminals, N, Actions, Rules, Verbose, Flag1).

% Modified to resolve shift-reduce conflicts
find_action_conflicts2([], _, _, _, _, _, Flag) ->
    Flag;
find_action_conflicts2([{Lookahead, Action} | Actions], Terminal, N, Found,
		       Rules, Verbose, Flag) ->
    case lists:member(Terminal, Lookahead) of
	true ->
	    case Found of
		[] ->
		    find_action_conflicts2(Actions, Terminal, N, [Action],
					   Rules, Verbose, Flag);
		[Action] ->
		    find_action_conflicts2(Actions, Terminal, N, Found, Rules,
					   Verbose, Flag);
		[{shift, _, {P1, Ass1}}] ->
		    case Action of
			{reduce, _, _, _, {P2, Ass2}} ->
			    if
				Verbose == true ->
				    report_action_conflict(Terminal, N, Found,
							   Action, Rules);
				true ->
				    do_nothing
			    end,
			    {Found1, Flag1} =
				if
				    P1 > P2 ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of shift.~n',
							  []);
					    true ->
						do_nothing
					end,
					{Found, Flag};
				    P2 > P1 ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of reduce.~n',
							  []);
					    true ->
						do_nothing
					end,
					{[Action], Flag};
				    Ass1 == left, Ass2 == left ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of reduce.~n',
							  []);
					    true ->
						do_nothing
					end,
					{[Action], Flag};
				    Ass1 == right, Ass2 == right ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of shift.~n',
							  []);
					    true ->
						do_nothing
					end,
					{Found, Flag};
				    P1 == 0, P2 == 0 ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of shift.~n',
							  []);
					    true ->
						do_nothing
					end,
					{Found, Flag};
				    true ->
					if
					    Verbose =/= true ->
						report_action_conflict(Terminal,
								       N, Found,
								       Action,
								       Rules);
					    true ->
						do_nothing
					end,
					{[Action | Found], error}
				end,
			    find_action_conflicts2(Actions, Terminal, N,
						   Found1, Rules, Verbose,
						   Flag1);
			_ ->
			    report_action_conflict(Terminal, N, Found, Action,
						   Rules),
			    find_action_conflicts2(Actions, Terminal, N,
						   [Action | Found], Rules,
						   Verbose, error)
		    end;
		[{reduce, _, Categ1, _, {P1, Ass1}}] ->
		    case Action of
			{shift, _, {P2, Ass2}} ->
			    if
				Verbose == true ->
				    report_action_conflict(Terminal, N, Found,
							   Action, Rules);
				true ->
				    do_nothing

			    end,
			    {Found1, Flag1} =
				if
				    P1 > P2 ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of reduce.~n',
							  []);
					    true ->
						do_nothing
					end,
					{Found, Flag};
				    P2 > P1 ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of shift.~n',
							  []);
					    true ->
						do_nothing
					end,
					{[Action], Flag};
				    Ass1 == left, Ass2 == left ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of reduce.~n',
							  []);
					    true ->
						do_nothing
					end,
					{Found, Flag};
				    Ass1 == right, Ass2 == right ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of shift.~n',
							  []);
					    true ->
						do_nothing
					end,
					{[Action], Flag};
				    P1 == 0, P2 == 0 ->
					if
					    Verbose == true ->
						io:format('Resolved in favor of shift.~n',
							  []);
					    true ->
						do_nothing
					end,
					{[Action], Flag};
				    true ->
					if
					    Verbose =/= true ->
						report_action_conflict(Terminal,
								       N, Found,
								       Action,
								       Rules);
					    true ->
						do_nothing
					end,
					{[Action | Found], error}
				end,
			    find_action_conflicts2(Actions, Terminal, N,
						   Found1, Rules, Verbose,
						   Flag1);
			{reduce, _, Categ2, _, {P2, _}} ->
			    if
				Verbose == true ->
				    report_action_conflict(Terminal, N, Found,
							   Action, Rules);
				true ->
				    do_nothing

			    end,
			    if
				P1 > P2 ->
				    if
					Verbose == true ->
					    io:format('Resolved in favor of ~w.~n',
						      [Categ1]);
					true ->
					    do_nothing
				    end,
				    find_action_conflicts2(Actions, Terminal,
							   N, Found, Rules,
							   Verbose, Flag);
				P2 > P1 ->
				    if
					Verbose == true ->
					    io:format('Resolved in favor of ~w.~n',
						      [Categ2]);
					true ->
					    do_nothing
				    end,
				    find_action_conflicts2(Actions, Terminal,
							   N, [Action], Rules,
							   Verbose, Flag);
				P1 == P2 ->
				    if
					Verbose =/= true ->
					    report_action_conflict(Terminal,
								   N, Found,
								   Action,
								   Rules);
					true ->
					    do_nothing
				    end,
				    find_action_conflicts2(Actions, Terminal,
							   N, [Action | Found],
							   Rules, Verbose,
							   error)
			    end;
			_ ->
			    report_action_conflict(Terminal, N, Found, Action,
						   Rules),
			    find_action_conflicts2(Actions, Terminal, N,
						   [Action | Found], Rules,
						   Verbose, error)
		    end;
		_ ->
		    case lists:member(Action, Found) of
			true ->
			    find_action_conflicts2(Actions, Terminal, N, Found,
						   Rules, Verbose, Flag);
			false ->
			    report_action_conflict(Terminal, N, Found, Action,
						   Rules),
			    find_action_conflicts2(Actions, Terminal, N,
						   [Action | Found], Rules,
						   Verbose, error)
		    end
	    end;
	false ->
	    find_action_conflicts2(Actions, Terminal, N, Found, Rules,
				   Verbose, Flag)
    end.

% Sort parse actions: according to operator precedences if there are any,
% otherwise accept and shift actions first,
% then the reduce actions with the one with most lookahead terminals last;
% this is to implement the "reduce as default" optimization in Aho & Johnson.
sort_parse_actions([]) ->
    [];
sort_parse_actions([{N, La_actions} | Tail]) ->
    [{N, sort_parse_actions1(La_actions)}
     | sort_parse_actions(Tail)].

sort_parse_actions1([]) ->
    [];
sort_parse_actions1([La_action | La_actions]) ->
    case lists:member(La_action, La_actions) of
	true ->
	    sort_parse_actions1(La_actions);
	false ->
	    insert_parse_action(La_action, sort_parse_actions1(La_actions))
    end.

insert_parse_action(La_action, []) ->
    [La_action];
insert_parse_action({Lookahead1, Action1}, [{Lookahead2, Action2} | Tail]) ->
    case Action1 of
	accept ->
	    [{Lookahead1, Action1}, {Lookahead2, Action2} | Tail];
	{shift, _, {P1, Ass1}} ->
	    case Action2 of
		{reduce, _, _, _, {P2, Ass2}} ->
		    case lists:member(hd(Lookahead1), Lookahead2) of
			true ->
			    if
				P1 > P2 ->
				    [{Lookahead1, Action1},
				     {Lookahead2, Action2} | Tail];
				P1 == P2 ->
				    if
					Ass1 == left, Ass2 == left ->
					    [{Lookahead2, Action2} | Tail];
					true ->
					    [{Lookahead1, Action1},
					     {Lookahead2, Action2} | Tail]
				    end;
				true ->
				    [{Lookahead2, Action2} | Tail]
			    end;
			false ->
			    if
				Tail == [] ->
				    [{Lookahead1, Action1},
				     {Lookahead2, Action2}];
				true ->
				    [{Lookahead2, Action2}
				     | insert_parse_action({Lookahead1,
							    Action1},
							   Tail)]
			    end
		    end;
		_ ->
		    [{Lookahead2, Action2}
		     | insert_parse_action({Lookahead1, Action1}, Tail)]
	    end;
	{reduce, _, _, _, {P1, Ass1}} ->
	    case Action2 of
		accept ->
		    [{Lookahead2, Action2}
		     | insert_parse_action({Lookahead1, Action1}, Tail)];
		{shift, _, {P2, Ass2}} ->
		    case lists:member(hd(Lookahead2), Lookahead1) of
			true ->
			    if
				P1 > P2 ->
				    insert_parse_action({Lookahead1, Action1},
							Tail);
				P1 == P2 ->
				    if
					Ass1 == left, Ass2 == left ->
					    insert_parse_action({Lookahead1,
								 Action1},
								Tail);
					true ->
					    [{Lookahead2, Action2}
					     | insert_parse_action({Lookahead1,
								    Action1},
								   Tail)]
				    end;
				true ->
				    [{Lookahead2, Action2}
				     | insert_parse_action({Lookahead1, Action1},
							   Tail)]
			    end;
			false ->
			    [{Lookahead2, Action2}
			     | insert_parse_action({Lookahead1, Action1},
						   Tail)]
		    end;
		{reduce, _, _, _, {P2, _}} ->
		    case intersect(Lookahead1, Lookahead2) of
			[] ->
			    if
				length(Lookahead1) =< length(Lookahead2) ->
				    [{Lookahead1, Action1},
				     {Lookahead2, Action2} | Tail];
				true ->
				    [{Lookahead2, Action2}
				     | insert_parse_action({Lookahead1, Action1},
							   Tail)]
			    end;
			_ ->
			    if
				P1 > P2 ->
				    [{Lookahead1, Action1},
				     {Lookahead2, Action2} | Tail];
				P1 < P2 ->
				    [{Lookahead2, Action2}
				     | insert_parse_action({Lookahead1, Action1},
							   Tail)];
				P1 == P2 ->
				    exit({yecc, Action1, Action2,
					  unresolved_parse_action_conflict})
			    end
		    end
	    end
    end.

report_action_conflict(Symbol, N, Found, New_action, Rules) ->
    io:format("*** Parse action conflict scanning symbol '~s' in state ~w:~n",
	      [Symbol, N]),
    case Found of
	[{reduce, Rule_nmbr1, _, _, _} | _] ->
	    R1 = rule(Rule_nmbr1, Rules),
	    io:format("   Reduce to '~w' from ~w (rule ~w)~n      vs.~n",
		      [hd(R1), tl(R1), Rule_nmbr1]),
	    case New_action of
		{reduce, Rule_nmbr2, _, _, _} ->
		    R2 = rule(Rule_nmbr2, Rules),
		    io:format("   reduce to '~w' from ~w (rule ~w).~n",
			      [hd(R2), tl(R2), Rule_nmbr2]);
		{shift, New_state, _} ->
		    io:format("   shift to state ~w, adding right sisters to '~w'.~n",
			      [New_state, lists:last(tl(R1))]);
		_ ->
		    io:format('   ~w.~n', [New_action])
	    end;
	[{shift, New_state, _} | _] ->
	    case New_action of
		{reduce, Rule_nmbr, _, _, _} ->
		    R = rule(Rule_nmbr, Rules),
		    io:format("   Reduce to '~w' from ~w (rule ~w)~n      vs.~n",
			      [hd(R), tl(R), Rule_nmbr]),
		    io:format("   shift to state ~w, adding right sisters to '~w'.~n",
			      [New_state, lists:last(tl(R))]);
		_ ->
		    io:format('   ~w vs. ~w.~n', [Found, New_action])
	    end;
	_ ->
	    io:format('   ~w vs. ~w.~n', [Found, New_action])
    end.

rule(Rule_pointer, Rules) ->
    element(1, lists:nth(Rule_pointer + 1, Rules)).


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

output_goto(Port, [], _) ->
    io:format(Port, 'yeccgoto(__Symbol, __State) ->~n', []),
    io:format(Port,
	      ' exit({__Symbol, __State, missing_in_goto_table}).~n~n', []);
output_goto(Port, [Nonterminal | Tail], Goto) ->
    output_goto1(Port, Nonterminal, Goto),
    output_goto(Port, Tail, Goto).

output_goto1(_, _, []) ->
    ok;
output_goto1(Port, Nonterminal, [{From, Nonterminal, To} | Tail]) ->
    io:format(Port, 'yeccgoto(~w, ~w) ->~n', [Nonterminal, From]),
    io:format(Port, ' ~w;~n', [To]),
    output_goto1(Port, Nonterminal, Tail);
output_goto1(Port, Nonterminal, [_ | Tail]) ->
    output_goto1(Port, Nonterminal, Tail).

% This produces a lot of function clauses; optimized as to reduce actions
output_parse_actions(Port, [], _, _) ->
    io:format(Port, 'yeccpars2(__Other, _, _, _, _, _, _) ->~n', []),
    io:format(Port,
	      ' exit({parser, __Other, missing_state_in_action_table}).~n~n',
	      []);
output_parse_actions(Port, [{State, La_actions} | Tail], Rules, Goto) ->
    output_parse_actions1(Port, State, La_actions, Rules, Goto),
    output_parse_actions(Port, Tail, Rules, Goto).

output_parse_actions1(Port, State, [], _, _) ->
    io:format(Port,
	      'yeccpars2(~w, _, _, _, __T, _, _) ->~n',
	      [State]),
%    io:format(Port, ' yeccerror(element(2, __T), __T);~n', []);
    io:format(Port, ' yeccerror(__T);~n', []);
output_parse_actions1(Port, State,
		      [{_, {reduce, Rule_nmbr, Head, Nmbr_of_daughters, _}}],
		      Rules, Goto) ->
    Code = code(Rule_nmbr, Rules),
    Open_stack =
	case Code of
	    [{var, _, '_1'}] when Nmbr_of_daughters == 1 ->
		io:format(Port,
			  'yeccpars2(~w, __Cat, __Ss, __Stack, __T, __Ts, __Tzr) ->~n',
			  [State]),
		false;
	    _ ->
		io:format(Port, 'yeccpars2(~w, __Cat, __Ss, ~s, __T, __Ts, __Tzr) ->~n',
			  [State, pp_exprs([create_stack(Nmbr_of_daughters)])]),
		case length(Code) of
		    1 ->
			io:format(Port, ' __Val = ~s,~n', [pp_exprs(Code)]);
		    _ ->
			io:format(Port, ' __Val = begin~n  ~s~n  end,~n',
				  [pp_exprs(Code)])
		end,
		true
	end,
    if
	Nmbr_of_daughters > 1 ->
	    io:format(Port, ' __Nss = lists:nthtail(~w, __Ss),~n',
		      [Nmbr_of_daughters - 1]);
	true ->
	    nothing
    end,
    case Nmbr_of_daughters of
	0 ->
	    Next_state = goto_lookup(State, Head, Goto),
	    io:format(Port,
		      ' yeccpars2(~w, __Cat, [~w | __Ss], ~s, __T, __Ts, __Tzr);~n',
		      [Next_state, State,
		       if Open_stack == true -> "[__Val | __Stack]";
			   true -> "__Stack" end]);
	1 ->
	    io:format(Port,
		      ' yeccpars2(yeccgoto(~w, hd(__Ss)), __Cat, __Ss, ~s, __T, __Ts, __Tzr);~n',
		      [Head,
		       if Open_stack == true -> "[__Val | __Stack]";
			   true -> "__Stack" end]);
	_ ->
	    io:format(Port,
		      ' yeccpars2(yeccgoto(~w, hd(__Nss)), __Cat, __Nss, ~s, __T, __Ts, __Tzr);~n',
		      [Head,
		       if Open_stack == true -> "[__Val | __Stack]";
			   true -> "__Stack" end])
    end;
output_parse_actions1(Port, State, [{Lookahead, Action} | Tail], Rules,
		      Goto) ->
    output_parse_actions2(Port, State, Lookahead, Action, Rules, Goto),
    output_parse_actions1(Port, State, Tail, Rules, Goto).

output_parse_actions2(_, _, [], _, _, _) ->
    ok;
output_parse_actions2(Port, State, [Terminal | Tail], Action, Rules, Goto) ->
    output_parse_actions3(Port, State, Terminal, Action, Rules, Goto),
    output_parse_actions2(Port, State, Tail, Action, Rules, Goto).

output_parse_actions3(Port, State, Terminal,
		      {reduce, Rule_nmbr, Head, Nmbr_of_daughters, _},
		      Rules, Goto) ->
    Code = code(Rule_nmbr, Rules),
    Open_stack =
	case Code of
	    [{var, _, '__1'}] when Nmbr_of_daughters == 1 ->
		io:format(Port,
			  'yeccpars2(~w, ~w, __Ss, __Stack, __T, __Ts, __Tzr) ->~n',
			  [State, Terminal]),
		false;
	    _ ->
		io:format(Port, 'yeccpars2(~w, ~w, __Ss,~s, __T, __Ts, __Tzr) ->~n',
			  [State, Terminal,
			   pp_exprs([create_stack(Nmbr_of_daughters)])]),
		case length(Code) of
		    1 ->
			io:format(Port, ' __Val = ~s,~n', [pp_exprs(Code)]);
		    _ ->
			io:format(Port, ' __Val = begin~n  ~s~n  end,~n',
				  [pp_exprs(Code)])
		end,
		true
	end,
    if
	Nmbr_of_daughters > 1 ->
	    io:format(Port, ' __Nss = lists:nthtail(~w, __Ss),~n',
		      [Nmbr_of_daughters - 1]);
	true ->
	    nothing
    end,
    case Nmbr_of_daughters of
	0 ->
	    Next_state = goto_lookup(State, Head, Goto),
	    io:format(Port,
		      ' yeccpars2(~w, ~w, [~w | __Ss], ~s, __T, __Ts, __Tzr);~n',
		      [Next_state, Terminal, State,
		       if Open_stack == true -> "[__Val | __Stack]";
			   true -> "__Stack" end]);
	1 ->
	    io:format(Port,
		      ' yeccpars2(yeccgoto(~w, hd(__Ss)), ~w, __Ss, ~s, __T, __Ts, __Tzr);~n',
		      [Head, Terminal,
		       if Open_stack == true -> "[__Val | __Stack]";
			   true -> "__Stack" end]);
	_ ->
	    io:format(Port,
		      ' yeccpars2(yeccgoto(~w, hd(__Nss)), ~w, __Nss, ~s, __T, __Ts, __Tzr);~n',
		      [Head, Terminal,
		       if Open_stack == true -> "[__Val | __Stack]";
			   true -> "__Stack" end])
    end;
output_parse_actions3(Port, State, Terminal, {shift, New_state, _}, Rules, _) ->
    io:format(Port, 'yeccpars2(~w, ~w, __Ss, __Stack, __T, __Ts, __Tzr) ->~n',
	      [State, Terminal]),
    io:format(Port,
	      ' yeccpars1(__Ts, __Tzr, ~w, [~w | __Ss], [__T | __Stack]);~n',
	      [New_state, State]);
output_parse_actions3(Port, State, Terminal, accept, _, _) ->
    io:format(Port, 'yeccpars2(~w, ~w, _, __Stack, _, _, _) ->~n',
	      [State, Terminal]),
    io:format(Port, ' {ok, hd(__Stack)};~n', []);
output_parse_actions3(Port, State, Terminal, error, _, _) ->
    io:format(Port, 'yeccpars2(~w, ~w, _, _, __T, _, _) ->~n',
	      [State, Terminal]),
%    io:format(Port, ' yeccerror(element(2, __T), __T);~n', []);
    io:format(Port, ' yeccerror(__T);~n', []);
output_parse_actions3(Port, State, Terminal, Other, _, _) ->
    io:format(Port, 'yeccpars2(~w, ~w, _, _, _, _, _) ->~n',
	      [State, Terminal]),
    io:format(Port, ' ~w;~n', [Other]).

create_stack(0) ->
    {var, 0, '__Stack'};
create_stack(N) when N > 0 ->
    {cons, 0, {var, 0, list_to_atom(lists:append("__", integer_to_list(N)))},
     create_stack(N - 1)}.

code(Rule_nmbr, Rules) ->
    element(2, lists:nth(Rule_nmbr + 1, Rules)).

goto_lookup(State, Cat, []) ->
    io:format('yecc error: ~w, ~w not in goto table!~n',
	      [State, Cat]),
    exit({yecc, bad_goto_table});
goto_lookup(State, Cat, [{State, Cat, Next_state} | Goto_table]) ->
    Next_state;
goto_lookup(State, Cat, [_ | Goto_table]) ->
    goto_lookup(State, Cat, Goto_table).
    
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliaries:

add_if_not_there(X, L) ->
    case lists:member(X, L) of
	true ->
	    L;
	false ->
	    [X | L]
    end.

intersect([], L) ->
    [];
intersect([H | T], L) ->
    case lists:member(H, L) of
	true ->
	    [H | intersect(T, L)];
	false ->
	    intersect(T, L)
    end.

ord_merge(L, []) ->
    L;
ord_merge([], L) ->
    L;
ord_merge([H | T1], [H | T2]) ->
    [H | ord_merge(T1, T2)];
ord_merge([H1 | T1], [H2 | T2]) when H1 < H2 ->
    [H1 | ord_merge(T1, [H2 | T2])];
ord_merge(L, [H | T]) ->
    [H | ord_merge(L, T)].

ord_subset([H | T1], [H | T2]) ->
    ord_subset(T1, T2);
ord_subset([H1 | _], [H2 | _]) when H1 < H2 ->
    false;
ord_subset([], _) ->
    true;
ord_subset(L, []) ->
    false;
ord_subset(L, [_ | T]) ->
    ord_subset(L, T).

ord_unique([]) ->
    [];
ord_unique([H]) ->
    [H];
ord_unique([H, H | T]) ->
    ord_unique([H | T]);
ord_unique([H | T]) ->
    [H | ord_unique(T)].

subset([], _) ->
    true;
subset([H | T], L) ->
    case lists:member(H, L) of
	true ->
	    subset(T, L);
	false ->
	    false
    end.

union([], L) ->
    L;
union([H | T], L) ->
    case lists:member(H, L) of
	true ->
	    union(T, L);
	false ->
	    [H | union(T, L)]
    end.


print_rule([Lhs | Rhs]) ->
    io:format('~w ->', [Lhs]),
    print_rule1(Rhs).

print_rule1([]) ->
    io:nl();
print_rule1([H | T]) ->
    io:format(' ~w', [H]),
    print_rule1(T).

include(File, Outport) ->
    case catch file:open(File, read) of
	{error, _} ->
	    io:format("Cannot find/read input file ~s!~n", [File]),
	    exit({include, bad_input_file});
	{'EXIT', _} ->
	    io:format("Cannot find/read input file ~s!~n", [File]),
	    exit({include, bad_input_file});
	{ok, Inport} ->
	    Line = io:get_line(Inport, ''),
	    include1(Line, Inport, Outport),
	    file:close(Inport)
    end.

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

pp_exprs([]) ->
    [];
pp_exprs([H]) ->
    [" ", erl_pp:expr(H)];
pp_exprs([H | T]) ->
    [" ", erl_pp:expr(H), "," | pp_exprs(T)].

%%% Interface to erl_compile.

compile(Input, Output, #options{verbose=Verbose, includes=Includes}) ->
    Args = [Input, Output, Verbose|include_option(Includes)],
    case catch apply(yecc, yecc, Args) of
	{'EXIT', {yecc, Reason}} ->
	    error;
	_Other ->
	    ok
    end.

include_option([]) ->
    [];
include_option([Include|_]) ->
    [Include].

