yecc.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2024. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.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.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
%% 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.
%%

-module(yecc).
-moduledoc """
LALR-1 Parser Generator

An LALR-1 parser generator for Erlang, similar to `yacc`. Takes a BNF grammar
definition as input, and produces Erlang code for a parser.

To understand this text, you also have to look at the `yacc` documentation in
the UNIX(TM) manual. This is most probably necessary in order to understand the
idea of a parser generator, and the principle and problems of LALR parsing with
finite look-ahead.

An nice introduction to `yacc` can be found in chapter 8 of "The UNIX
Programming Environment" by Brian W. Kernighan and Rob Pike.

## Default Yecc Options

The (host operating system) environment variable `ERL_COMPILER_OPTIONS` can be
used to give default Yecc options. Its value must be a valid Erlang term. If the
value is a list, it is used as is. If it is not a list, it is put into a list.

The list is appended to any options given to `file/2`.

The list can be retrieved with `compile:env_compiler_options/0`.

## Pre-Processing

A `scanner` to pre-process the text (program) to be parsed is not provided
in the `yecc` module. The scanner serves as a kind of lexicon look-up routine.
It is possible to write a grammar that uses only character tokens as terminal
symbols, thereby eliminating the need for a scanner, but this would make the
parser larger and slower.

The user should implement a scanner that segments the input text, and turns it
into one or more lists of tokens. Each token should be a tuple containing
information about syntactic category, position in the text (for example
line number), and the actual terminal symbol found in the text:
`{Category, Position, Symbol}`.

If a terminal symbol is the only member of a category, and the symbol name is
identical to the category name, the token format can be `{Symbol, Position}`.

A list of tokens produced by the scanner should end with a special
`end_of_input` tuple which the parser is looking for. The format of this tuple
should be `{Endsymbol, EndPosition}`, where `Endsymbol` is an identifier that is
distinguished from all the terminal and non-terminal categories of the syntax
rules. The `Endsymbol` can be declared in the grammar file.

The simplest case is to segment the input string into a list of identifiers
(atoms) and use those atoms both as categories and values of the tokens. For
example, the input string `aaa bbb 777, X` may be scanned (tokenized) as:

```erlang
[{aaa, 1}, {bbb, 1}, {777, 1}, {',' , 1}, {'X', 1},
 {'$end', 1}].
```

This assumes that this is the first line of the input text, and that `'$end'` is
the distinguished `end_of_input` symbol.

The Erlang scanner in the `io` module can be used as a starting point when
writing a new scanner. Study `yeccscan.erl` in order to see how a filter can be
added on top of `io:scan_erl_form/3` to provide a scanner for Yecc that
tokenizes grammar files before parsing them with the Yecc parser. A more general
approach to scanner implementation is to use a scanner generator such as
`m:leex`.

## Grammar Definition Format

Erlang style `comments`, starting with a `'%'`, are allowed in grammar files.

Each `declaration` or `rule` ends with a dot (the character `'.'`).

The grammar starts with an optional `header` section. The header is put first in
the generated file, before the module declaration. The purpose of the header is
to provide a means to make the documentation generated by [EDoc](`e:edoc:edoc.md`)
look nicer. Each header line should be enclosed in double quotes, and newlines
will be inserted between the lines. For example:

```erlang
Header "%% Copyright (C)"
"%% @private"
"%% @Author John".
```

Next comes a declaration of the `nonterminal categories` to be used in the
rules. For example:

```text
Nonterminals sentence nounphrase verbphrase.
```

A non-terminal category can be used at the left-hand side (= `lhs`, or `head`)
of a grammar rule. It can also appear at the right-hand side of rules.

Next comes a declaration of the `terminal categories`, which are the categories
of tokens produced by the scanner. For example:

```text
Terminals article adjective noun verb.
```

Terminal categories may only appear in the right hand sides (= `rhs`) of grammar
rules.

Next comes a declaration of the `rootsymbol`, or start category of the grammar.
For example:

```text
Rootsymbol sentence.
```

This symbol should appear in the lhs of at least one grammar rule. This is the
most general syntactic category which the parser ultimately will parse every
input string into.

After the rootsymbol declaration comes an optional declaration of the
`end_of_input` symbol that your scanner is expected to use. For example:

```text
Endsymbol '$end'.
```

Next comes one or more declarations of *operator precedences*, if needed. These
are used to resolve shift/reduce conflicts (see `yacc` documentation).

Examples of operator declarations:

```text
Right 100 '='.
Nonassoc 200 '==' '=/='.
Left 300 '+'.
Left 400 '*'.
Unary 500 '-'.
```

These declarations mean that `'='` is defined as a `right associative binary`
operator with precedence 100, `'=='` and `'=/='` are operators with
`no associativity`, `'+'` and `'*'` are `left associative binary` operators,
where `'*'` takes precedence over `'+'` (the normal case), and `'-'` is a
`unary` operator of higher precedence than `'*'`. The fact that '==' has no
associativity means that an expression like `a == b == c` is considered a syntax
error.

Certain rules are assigned precedence: each rule gets its precedence from the
last terminal symbol mentioned in the right hand side of the rule. It is also
possible to declare precedence for non-terminals, "one level up". This is
practical when an operator is overloaded (see also example 3 below).

Next come the *grammar rules*. Each rule has the general form

```erlang
Left_hand_side -> Right_hand_side : Associated_code.
```

The left hand side is a non-terminal category. The right hand side is a sequence
of one or more non-terminal or terminal symbols with spaces between. The
associated code is a sequence of zero or more Erlang expressions (with commas
`','` as separators). If the associated code is empty, the separating colon
`':'` is also omitted. A final dot marks the end of the rule.

Symbols such as `'{'`, `'.'`, and so on, have to be enclosed in single quotes
when used as terminal or non-terminal symbols in grammar rules. The use of the
symbols `'$empty'`, `'$end'`, and `'$undefined'` should be avoided.

The last part of the grammar file is an optional section with Erlang code (=
function definitions) which is included 'as is' in the resulting parser file.
This section must start with the pseudo declaration, or key words

```text
Erlang code.
```

No syntax rule definitions or other declarations must follow this section. To
avoid conflicts with internal variables, do not use variable names beginning
with two underscore characters (`'__'`) in the Erlang code in this section, or
in the code associated with the individual syntax rules.

The optional `expect` declaration can be placed anywhere before the last
optional section with Erlang code. It is used for suppressing the warning about
conflicts that is ordinarily given if the grammar is ambiguous. An example:

```text
Expect 2.
```

The warning is given if the number of shift/reduce conflicts differs from 2, or
if there are reduce/reduce conflicts.

## Examples

A grammar to parse list expressions (with empty associated code):

```text
Nonterminals list elements element.
Terminals atom '(' ')'.
Rootsymbol list.
list -> '(' ')'.
list -> '(' elements ')'.
elements -> element.
elements -> element elements.
element -> atom.
element -> list.
```

This grammar can be used to generate a parser which parses list expressions,
such as `(), (a), (peter charles), (a (b c) d (())), ...` provided that your
scanner tokenizes, for example, the input `(peter charles)` as follows:

```erlang
[{'(', 1} , {atom, 1, peter}, {atom, 1, charles}, {')', 1},
 {'$end', 1}]
```

When a grammar rule is used by the parser to parse (part of) the input string as
a grammatical phrase, the associated code is evaluated, and the value of the
last expression becomes the value of the parsed phrase. This value may be used
by the parser later to build structures that are values of higher phrases of
which the current phrase is a part. The values initially associated with
terminal category phrases, i.e. input tokens, are the token tuples themselves.

Below is an example of the grammar above with structure building code added:

```text
list -> '(' ')' : nil.
list -> '(' elements ')' : '$2'.
elements -> element : {cons, '$1', nil}.
elements -> element elements : {cons, '$1', '$2'}.
element -> atom : '$1'.
element -> list : '$1'.
```

With this code added to the grammar rules, the parser produces the following
value (structure) when parsing the input string `(a b c).`. This still assumes
that this was the first input line that the scanner tokenized:

```erlang
{cons, {atom, 1, a}, {cons, {atom, 1, b},
                            {cons, {atom, 1, c}, nil}}}
```

The associated code contains `pseudo variables` `'$1'`, `'$2'`,
`'$3'`, and so on.  which refer to (are bound to) the values
associated previously by the parser with the symbols of the right-hand
side of the rule. When these symbols are terminal categories, the
values are token tuples of the input string (see above).

The associated code may not only be used to build structures
associated with phrases, but may also be used for syntactic and
semantic tests, printout actions (for example for tracing), and so on
during the parsing process. Since tokens contain positional (line
number) information, it is possible to produce error messages which
contain line numbers. If there is no associated code after the
right-hand side of the rule, the value `'$undefined'` is associated
with the phrase.

The right-hand side of a grammar rule can be empty. This is indicated by using
the special symbol `'$empty'` as rhs. Then the list grammar above can be
simplified to:

```text
list -> '(' elements ')' : '$2'.
elements -> element elements : {cons, '$1', '$2'}.
elements -> '$empty' : nil.
element -> atom : '$1'.
element -> list : '$1'.
```

## Generating a Parser

To call the parser generator, use the following command:

```erlang
yecc:file(Grammarfile).
```

An error message from Yecc will be shown if the grammar is not of the LALR type
(for example too ambiguous). Shift/reduce conflicts are resolved in favor of
shifting if there are no operator precedence declarations. Refer to the `yacc`
documentation on the use of operator precedence.

The output file contains Erlang source code for a parser module with module name
equal to the `Parserfile` parameter. After compilation, the parser can be called
as follows (the module name is assumed to be `myparser`):

```erlang
myparser:parse(myscanner:scan(Inport))
```

The call format can be different if a customized prologue file has been included
when generating the parser instead of the default file
`lib/parsetools/include/yeccpre.hrl`.

With the standard prologue, this call will return either `{ok, Result}`, where
`Result` is a structure that the Erlang code of the grammar file has built, or
`{error, {Position, Module, Message}}` if there was a syntax error in the input.

`Message` is something which may be converted into a string by calling
`Module:format_error(Message)` and printed with `io:format/3`.

> #### Note {: .info }
>
> By default, the parser that was generated will not print out error messages to
> the screen. The user will have to do this either by printing the returned
> error messages, or by inserting tests and print instructions in the Erlang
> code associated with the syntax rules of the grammar file.

It is also possible to make the parser ask for more input tokens when needed if
the following call format is used:

```erlang
myparser:parse_and_scan({Function, Args})
myparser:parse_and_scan({Mod, Tokenizer, Args})
```

The tokenizer `Function` is either a fun or a tuple `{Mod, Tokenizer}`. The call
[`apply(Function, Args)`](`apply/2`) or
[`apply({Mod, Tokenizer}, Args)`](`apply/2`) is executed whenever a new token is
needed. This, for example, makes it possible to parse from a file, token by
token.

The tokenizer used above has to be implemented so as to return one of the
following:

```erlang
{ok, Tokens, EndPosition}
{eof, EndPosition}
{error, Error_description, EndPosition}
```

This conforms to the format used by the scanner in the Erlang `io` library
module.

If `{eof, EndPosition}` is returned immediately, the call to `parse_and_scan/1`
returns `{ok, eof}`. If `{eof, EndPosition}` is returned before the parser
expects end of input, `parse_and_scan/1` will, of course, return an error
message (see above). Otherwise `{ok, Result}` is returned.

## More Examples

1\. A grammar for parsing infix arithmetic expressions into prefix notation,
without operator precedence:

```text
Nonterminals E T F.
Terminals '+' '*' '(' ')' number.
Rootsymbol E.
E -> E '+' T: {'$2', '$1', '$3'}.
E -> T : '$1'.
T -> T '*' F: {'$2', '$1', '$3'}.
T -> F : '$1'.
F -> '(' E ')' : '$2'.
F -> number : '$1'.
```

2\. The same with operator precedence becomes simpler:

```text
Nonterminals E.
Terminals '+' '*' '(' ')' number.
Rootsymbol E.
Left 100 '+'.
Left 200 '*'.
E -> E '+' E : {'$2', '$1', '$3'}.
E -> E '*' E : {'$2', '$1', '$3'}.
E -> '(' E ')' : '$2'.
E -> number : '$1'.
```

3\. An overloaded minus operator:

```text
Nonterminals E uminus.
Terminals '*' '-' number.
Rootsymbol E.

Left 100 '-'.
Left 200 '*'.
Unary 300 uminus.

E -> E '-' E.
E -> E '*' E.
E -> uminus.
E -> number.

uminus -> '-' E.
```

4\. The Yecc grammar that is used for parsing grammar files, including itself:

```erlang
Nonterminals
grammar declaration rule head symbol symbols attached_code
token tokens.
Terminals
atom float integer reserved_symbol reserved_word string char var
'->' ':' dot.
Rootsymbol grammar.
Endsymbol '$end'.
grammar -> declaration : '$1'.
grammar -> rule : '$1'.
declaration -> symbol symbols dot: {'$1', '$2'}.
rule -> head '->' symbols attached_code dot: {rule, ['$1' | '$3'],
        '$4'}.
head -> symbol : '$1'.
symbols -> symbol : ['$1'].
symbols -> symbol symbols : ['$1' | '$2'].
attached_code -> ':' tokens : {erlang_code, '$2'}.
attached_code -> '$empty' : {erlang_code,
                 [{atom, 0, '$undefined'}]}.
tokens -> token : ['$1'].
tokens -> token tokens : ['$1' | '$2'].
symbol -> var : value_of('$1').
symbol -> atom : value_of('$1').
symbol -> integer : value_of('$1').
symbol -> reserved_word : value_of('$1').
token -> var : '$1'.
token -> atom : '$1'.
token -> float : '$1'.
token -> integer : '$1'.
token -> string : '$1'.
token -> char : '$1'.
token -> reserved_symbol : {value_of('$1'), line_of('$1')}.
token -> reserved_word : {value_of('$1'), line_of('$1')}.
token -> '->' : {'->', line_of('$1')}.
token -> ':' : {':', line_of('$1')}.
Erlang code.
value_of(Token) ->
    element(3, Token).
line_of(Token) ->
    element(2, Token).
```

> #### Note {: .info }
>
> The symbols `'->'`, and `':'` have to be treated in a special way, as they are
> meta symbols of the grammar notation, as well as terminal symbols of the Yecc
> grammar.

5\. The file `erl_parse.yrl` in the `lib/stdlib/src` directory contains the
grammar for Erlang.

> #### Note {: .info }
>
> Syntactic tests are used in the code associated with some rules, and an error
> is thrown (and caught by the generated parser to produce an error message)
> when a test fails. The same effect can be achieved with a call to
> `return_error(ErrorPosition, Message_string)`, which is defined in the
> `yeccpre.hrl` default header file.

## Files

```text
lib/parsetools/include/yeccpre.hrl
```

## See Also

* Aho & Johnson: 'LR Parsing', ACM Computing Surveys, vol. 6:2, 1974.

* Kernighan & Pike: The UNIX programming environment, 1984.
""".

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

-export_type([option/0, yecc_ret/0]).

%% Kept for compatibility with R10B.
-export([yecc/2, yecc/3, yecc/4]).

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

-include("erl_compile.hrl").
-include("ms_transform.hrl").

-record(yecc, {
          infile,
          outfile,
          includefile,
          includefile_version,
          module,
          encoding = none,
          options = [],
          verbose = false,
          file_attrs = true,
          errors = [],
          warnings = [],
          conflicts_done = false,
          shift_reduce = [],
          reduce_reduce = [],
          n_states = 0,
          inport,
          outport,
          line,

          parse_actions,
          symbol_tab,
          inv_symbol_tab,
          state_tab,
          prec_tab,
          goto_tab,

          terminals = [],
          nonterminals = [],
          all_symbols = [],
          prec = [],
          rules_list = [],
          rules, % a tuple of rules_list
          rule_pointer2rule,
          rootsymbol = [],
          endsymbol = [],
          expect_shift_reduce = [],
          expect_n_states = [],
          header = [],
          erlang_code = none
         }).

-record(rule, {
          n,             % rule n in the grammar file
          location,
          symbols,       % the names of symbols
          tokens,
          is_guard,      % the action is a guard (not used)
          is_well_formed % can be parsed (without macro expansion)
         }).

-record(reduce, {
          rule_nmbr,
          head,
          nmbr_of_daughters,
          prec,
          unused % assure that #reduce{} comes before #shift{} when sorting
         }).

-record(shift, {
          state,
          pos,
          prec,
          rule_nmbr
         }).

-record(user_code, {state, terminal, funname, action}).

-record(symbol, {anno = none, name}).

%% ACCEPT is neither an atom nor a non-terminal.
-define(ACCEPT, {}).

%% During the phase 'compute_states' terminals in lookahead sets are
%% coded as integers; sets of terminals are integer bit masks. This is
%% for efficiency only. '$empty' is always given the mask 1. The
%% behaviour can be turned off by un-defining SYMBOLS_AS_CODES (useful
%% when debugging).

%% Non-terminals are also given integer codes, starting with -1. The
%% absolute value of the code is used for indexing a tuple of lists of
%% rules.

-define(SYMBOLS_AS_CODES, true).

-ifdef(SYMBOLS_AS_CODES).
-define(EMPTY, 0).
-else.
-define(EMPTY, '$empty').
-endif.

%%%
%%% Exported functions
%%%

%%% Interface to erl_compile.

-doc false.
compile(Input0, Output0, 
        #options{warning = WarnLevel, verbose=Verbose, includes=Includes,
		 specific=Specific}) ->
    Input = shorten_filename(Input0),
    Output = shorten_filename(Output0),
    Includefile = lists:sublist(Includes, 1),
    Werror = proplists:get_bool(warnings_as_errors, Specific),
    Deterministic = proplists:get_bool(deterministic, Specific),
    Opts = [{parserfile,Output}, {includefile,Includefile}, {verbose,Verbose},
            {report_errors, true}, {report_warnings, WarnLevel > 0},
	    {warnings_as_errors, Werror}, {deterministic, Deterministic}],
    case file(Input, Opts) of
        {ok, _OutFile} ->
            ok;
        error ->
            error
    end.

-doc """
Returns a descriptive string in English of an error reason `ErrorDescriptor`
returned by `yecc:file/1,2`.

This function is mainly used by the compiler invoking Yecc.
""".
-spec format_error(ErrorDescriptor) -> io_lib:chars() when
      ErrorDescriptor :: term().

format_error(bad_declaration) ->
    io_lib:fwrite("unknown or bad declaration, ignored", []);
format_error({bad_expect, SymName}) ->
    io_lib:fwrite("argument ~ts of Expect is not an integer", 
                  [format_symbol(SymName)]);
format_error({bad_rootsymbol, SymName}) ->
    io_lib:fwrite("rootsymbol ~ts is not a nonterminal", 
                  [format_symbol(SymName)]);
format_error({bad_states, SymName}) ->
    io_lib:fwrite("argument ~ts of States is not an integer", 
                  [format_symbol(SymName)]);
format_error({conflict, Conflict}) ->
    format_conflict(Conflict);
format_error({conflicts, SR, RR}) ->
    io_lib:fwrite("conflicts: ~w shift/reduce, ~w reduce/reduce", [SR, RR]);
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 ~ts", 
                  [format_symbol(Nonterminal)]);
format_error({duplicate_precedence, Op}) ->
    io_lib:fwrite("duplicate precedence operator ~ts", 
                  [format_symbol(Op)]);
format_error({duplicate_terminal, Terminal}) ->
    io_lib:fwrite("duplicate terminal ~ts", 
                  [format_symbol(Terminal)]);
format_error({endsymbol_is_nonterminal, Symbol}) ->
    io_lib:fwrite("endsymbol ~ts is a nonterminal", 
                  [format_symbol(Symbol)]);
format_error({endsymbol_is_terminal, Symbol}) ->
    io_lib:fwrite("endsymbol ~ts is a terminal", 
                  [format_symbol(Symbol)]);
format_error({error, Module, Error}) ->
    Module:format_error(Error);
format_error({file_error, Reason}) ->
    io_lib:fwrite("~ts",[file:format_error(Reason)]);
format_error(illegal_empty) ->
    io_lib:fwrite("illegal use of empty symbol", []);
format_error({internal_error, Error}) ->
    io_lib:fwrite("internal yecc error: ~w", [Error]);
format_error({missing_syntax_rule, Nonterminal}) ->
    io_lib:fwrite("no syntax rule for non-terminal symbol ~ts",
                  [format_symbol(Nonterminal)]);
format_error({n_states, Exp, N}) ->
    io_lib:fwrite("expected ~w states, but got ~p states", [Exp, N]);
format_error(no_grammar_rules) ->
    io_lib:fwrite("grammar rules are missing", []);
format_error(nonterminals_missing) ->
    io_lib:fwrite("Nonterminals is missing", []);
format_error({precedence_op_is_endsymbol, SymName}) ->
    io_lib:fwrite("precedence operator ~ts is endsymbol",
                  [format_symbol(SymName)]);
format_error({precedence_op_is_unknown, SymName}) ->
    io_lib:fwrite("unknown precedence operator ~ts",
                  [format_symbol(SymName)]);
format_error({reserved, N}) ->
    io_lib:fwrite("the use of ~w should be avoided", [N]);
format_error({symbol_terminal_and_nonterminal, SymName}) ->
    io_lib:fwrite("symbol ~ts 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 is missing", []);
format_error({undefined_nonterminal, Symbol}) ->
    io_lib:fwrite("undefined nonterminal: ~ts", [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 ~ts", [format_symbol(SymName)]);
format_error({unused_nonterminal, Nonterminal}) ->
    io_lib:fwrite("non-terminal symbol ~ts not used", 
                  [format_symbol(Nonterminal)]);
format_error({unused_terminal, Terminal}) ->
    io_lib:fwrite("terminal symbol ~ts not used", 
                  [format_symbol(Terminal)]);
format_error({bad_symbol, String}) ->
    io_lib:fwrite("bad symbol ~ts", [String]);
format_error(cannot_parse) ->
    io_lib:fwrite("cannot parse; possibly encoding mismatch", []).

-doc """
The standard `t:error_info/0` structure that is returned from all I/O modules.

`ErrorDescriptor` is formattable by `format_error/1`.
""".
-type error_info() :: {erl_anno:location() | 'none',
                       module(), ErrorDescriptor :: term()}.
-type errors() :: [{file:filename(), [error_info()]}].
-type warnings() :: [{file:filename(), [error_info()]}].
-type ok_ret() :: {'ok', Parserfile :: file:filename()}
                | {'ok', Parserfile :: file:filename(), warnings()}.
-type error_ret() :: 'error'
                  | {'error', Errors :: errors(), Warnings :: warnings()}.
-type yecc_ret() :: ok_ret() | error_ret().
-type option() :: {'error_location', 'column' | 'line'}
                | {'includefile', Includefile :: file:filename()}
                | {'report_errors', boolean()}
                | {'report_warnings', boolean()}
                | {'report', boolean()}
                | {'return_errors', boolean()}
                | {'return_warnings', boolean()}
                | {'return', boolean()}
                | {'parserfile', Parserfile :: file:filename()}
                | {'verbose', boolean()}
                | {'warnings_as_errors', boolean()}
                | {'deterministic', boolean()}
                | 'report_errors' | 'report_warnings' | 'report'
                | 'return_errors' | 'return_warnings' | 'return'
                | 'verbose' | 'warnings_as_errors'.

-doc #{equiv => file(GrammarFile, [report_errors, report_warnings])}.
-spec file(GrammarFile) -> yecc_ret() when
      GrammarFile :: file:filename().

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

-doc """
Generates an Erlang file with the parser for the language described by `GrammarFile`.

`Grammarfile` is the file of declarations and grammar rules. Returns `ok` upon
success, or `error` if there are errors. An Erlang file containing the parser is
created if there are no errors.

The options are:

- **`{includefile, Includefile}`.** - Indicates a customized prologue file which
  the user may want to use instead of the default file
  `lib/parsetools/include/yeccpre.hrl` which is otherwise included at the
  beginning of the resulting parser file. Note taht `Includefile` is included
  as is in the parser file, so it must not have a module declaration of its
  own, and it should not be compiled. It must, however, contain the necessary
  export declarations. The default is indicated by `""`.

- **`{parserfile, Parserfile}`.** - `Parserfile` is the name of the file that
  will contain the Erlang parser code that is generated. The default (`""`) is
  to add the extension `.erl` to `Grammarfile` stripped of the `.yrl` extension.

- **`{report_errors, boolean()}`.** - Causes errors to be printed as they occur.
  Default is `true`.

- **`{report_warnings, boolean()}`.** - Causes warnings to be printed as they
  occur. Default is `true`.

- **`{report, boolean()}`.** - This is a short form for both `report_errors` and
  `report_warnings`.

- **`{return_errors, boolean()}`.** - If this flag is set,
  `{error, Errors, Warnings}` is returned when there are errors. Default is
  `false`.

- **`{return_warnings, boolean()}`.** - If this flag is set, an extra field
  containing `Warnings` is added to the tuple returned upon success. Default is
  `false`.

- **`{return, boolean()}`.** - This is a short form for both `return_errors` and
  `return_warnings`.

- **`{verbose, boolean()}`.** - Determines whether the parser generator should
  give full information about resolved and unresolved parse action conflicts
  (`true`), or only about those conflicts that prevent a parser from being
  generated from the input grammar (`false`, the default).

- **`{warnings_as_errors, boolean()}`** - Causes warnings to be treated as
  errors.

- **`{error_location, column | line}`.** - If the value of this flag is `line`,
  the location of warnings and errors is a line number. If the value is
  `column`, the location includes a line number and a column number. Default is
  `column`.

- **`{deterministic, boolean()}`** - Causes generated `-file()` attributes to only
  include the basename of the file path.

Any of the Boolean options can be set to `true` by stating the name of the
option. For example, `verbose` is equivalent to `{verbose, true}`.

The value of the `Parserfile` option stripped of the `.erl` extension is used by
Yecc as the module name of the generated parser file.

Yecc will add the extension `.yrl` to the `Grammarfile` name, the extension
`.hrl` to the `Includefile` name, and the extension `.erl` to the `Parserfile`
name, unless the extension is already there.
""".
-spec file(GrammarFile, Options) -> yecc_ret() when
      GrammarFile :: file:filename(),
      Options :: Option | [Option],
      Option :: option().

file(File, Options0) when is_list(Options0) ->
    case is_filename(File) of
        no -> erlang:error(badarg, [File, Options0]);
        _ -> ok
    end,
    EnvOpts0 = env_default_opts(),
    EnvOpts = select_recognized_opts(EnvOpts0),
    Options = Options0 ++ EnvOpts,
    case options(Options) of
        badarg ->
            erlang:error(badarg, [File, Options]);
        OptionValues ->
            Self = self(),
            Flag = process_flag(trap_exit, false),
            Pid = spawn_link(fun() -> infile(Self, File, OptionValues) end),
            receive
                {Pid, Rep} -> 
                    receive after 1 -> ok end,
                    process_flag(trap_exit, Flag),
                    Rep
            end
    end;
file(File, Option) ->
    file(File, [Option]).

%% Kept for backward compatibility.
-doc false.
yecc(Infile, Outfile) ->
    yecc(Infile, Outfile, false, []).

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

-doc false.
yecc(Infilex, Outfilex, Verbose, Includefilex) ->
    _ = statistics(runtime),
    case file(Infilex, [{parserfile, Outfilex}, 
                        {verbose, Verbose}, 
                        {report, true},
                        {includefile, Includefilex}]) of
        {ok, _File} ->
            statistics(runtime);
        error ->
            exit(error)
    end.

%%%
%%% Local functions
%%%

%% Copied from compile.erl.
env_default_opts() ->
    Key = "ERL_COMPILER_OPTIONS",
    case os:getenv(Key) of
	false -> [];
	Str when is_list(Str) ->
	    case erl_scan:string(Str) of
		{ok,Tokens,_} ->
                    Dot = {dot, erl_anno:new(1)},
		    case erl_parse:parse_term(Tokens ++ [Dot]) of
			{ok,List} when is_list(List) -> List;
			{ok,Term} -> [Term];
			{error,_Reason} ->
			    io:format("Ignoring bad term in ~s\n", [Key]),
			    []
		    end;
		{error, {_,_,_Reason}, _} ->
		    io:format("Ignoring bad term in ~s\n", [Key]),
		    []
	    end
    end.

select_recognized_opts(Options0) ->
    Options = preprocess_options(Options0),
    AllOptions = all_options(),
    [Option ||
        {Name, _} = Option <- Options,
        lists:member(Name, AllOptions)].

options(Options0) ->
    Options1 = preprocess_options(Options0),
    AllOptions = all_options(),
    case check_options(Options1, AllOptions, []) of
        badarg ->
            badarg;
        OptionValues  ->
            AllOptionValues =
                [case lists:keyfind(Option, 1, OptionValues) of
                     false ->
                         {Option, default_option(Option)};
                     OptionValue ->
                         OptionValue
                 end || Option <- AllOptions],
            foldr(fun({_, false}, L) -> L;
                     ({Option, true}, L) -> [Option | L];
                     (OptionValue, L) -> [OptionValue | L]
                  end, [], AllOptionValues)
    end.

preprocess_options(Options) ->
    foldr(fun preproc_opt/2, [], Options).

preproc_opt(return, Os) ->
    [{return_errors, true}, {return_warnings, true} | Os];
preproc_opt(report, Os) ->
    [{report_errors, true}, {report_warnings, true} | Os];
preproc_opt({return, T}, Os) ->
    [{return_errors, T}, {return_warnings, T} | Os];
preproc_opt({report, T}, Os) ->
    [{report_errors, T}, {report_warnings, T} | Os];
preproc_opt(Option, Os) ->
    [try atom_option(Option) catch error:_ -> Option end | Os].

check_options([{Option, FileName0} | Options], AllOptions, L)
          when Option =:= includefile; Option =:= parserfile ->
    case is_filename(FileName0) of
        no -> 
            badarg;
        Filename -> 
            check_options(Options, AllOptions, [{Option, Filename} | L])
    end;
check_options([{error_location, ELoc}=OptionValue | Options], AllOptions, L)
          when ELoc =:= column; ELoc =:= line ->
    check_options(Options, AllOptions, [OptionValue | L]);
check_options([{Option, Boolean}=OptionValue | Options], AllOptions, L)
          when is_boolean(Boolean) ->
    case lists:member(Option, AllOptions) of
        true ->
            check_options(Options, AllOptions, [OptionValue | L]);
        false ->
            badarg
        end;
check_options([], _AllOptions, L) ->
    L;
check_options(_Options, _, _L) ->
    badarg.

all_options() ->
    [error_location, file_attributes, includefile, parserfile,
     report_errors, report_warnings, return_errors, return_warnings,
     time, verbose, warnings_as_errors, deterministic].

default_option(error_location) -> column;
default_option(file_attributes) -> true;
default_option(includefile) -> [];
default_option(parserfile) -> [];
default_option(report_errors) -> true;
default_option(report_warnings) -> true;
default_option(return_errors) -> false;
default_option(return_warnings) -> false;
default_option(time) -> false;
default_option(verbose) -> false;
default_option(warnings_as_errors) -> false;
default_option(deterministic) -> false.

atom_option(file_attributes) -> {file_attributes, true};
atom_option(report_errors) -> {report_errors, true};
atom_option(report_warnings) -> {report_warnings, true};
atom_option(return_errors) -> {return_errors, true};
atom_option(return_warnings) -> {return_warnings, true};
atom_option(time) -> {time, true};
atom_option(verbose) -> {verbose, true};
atom_option(warnings_as_errors) -> {warnings_as_errors, true};
atom_option(deterministic) -> {deterministic, true};
atom_option(Key) -> Key.

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

shorten_filename(Name0) ->
    {ok,Cwd} = file:get_cwd(),
    case string:prefix(Name0, Cwd) of
        nomatch -> Name0;
        Rest ->
            case unicode:characters_to_list(Rest) of
                "/"++N -> N;
                N -> N
            end
    end.

start(Infilex, Options) ->
    Infile = assure_extension(Infilex, ".yrl"),
    {_, Outfilex0} = lists:keyfind(parserfile, 1, Options),
    {_, Includefilex} = lists:keyfind(includefile, 1, Options),
    Outfilex = case Outfilex0 of
                   [] -> filename:rootname(Infilex, ".yrl");
                   _ -> Outfilex0
               end,
    Includefile = case Includefilex of
                      [] -> [];
                      _ -> assure_extension(Includefilex,".hrl")
                  end,
    IncludefileVersion = includefile_version(Includefile),
    Outfile = assure_extension(Outfilex, ".erl"),
    Module = list_to_atom(filename:basename(Outfile, ".erl")),
    #yecc{infile = Infile, 
          outfile = Outfile,
          includefile = Includefile,
          includefile_version = IncludefileVersion,
          module = Module,
          options = Options,
          verbose = member(verbose, Options),
          file_attrs = member(file_attributes, Options)}.

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

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

infile(Parent, Infilex, Options) ->
    St0 = start(Infilex, Options),
    St = case file:open(St0#yecc.infile, [read, read_ahead]) of
             {ok, Inport} ->
                 try 
                     Encoding = epp:set_encoding(Inport),
                     St1 = St0#yecc{inport = Inport, encoding = Encoding},
                     outfile(St1)
                 after
                     ok = file:close(Inport)
                 end;
             {error, Reason} ->
                 add_error(St0#yecc.infile, none, {file_error, Reason}, St0)
         end,
    case {St#yecc.errors, werror(St)} of
        {[], false} -> ok;
        _ -> _ = file:delete(St#yecc.outfile), ok
    end,
    Parent ! {self(), yecc_ret(St)}.

werror(St) ->
    St#yecc.warnings =/= []
	andalso member(warnings_as_errors, St#yecc.options).

outfile(St0) ->
    case file:open(St0#yecc.outfile, [write, delayed_write]) of
        {ok, Outport} ->
            try 
                %% Set the same encoding as infile:
                set_encoding(St0, Outport),
                generate(St0#yecc{outport = Outport, line = 1})
            catch 
                throw: St1  ->
                    St1;
                exit: Reason ->
                    add_error({internal_error, Reason}, St0)
            after
               ok = file:close(Outport)
            end;
        {error, Reason} ->
            add_error(St0#yecc.outfile, none, {file_error, Reason}, St0)
    end.

os_process_size() ->
    case os:type() of
        {unix, sunos} ->
            Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
            list_to_integer(nonl(Size));
        _ ->
            0
    end.

nonl([$\n]) -> [];
nonl([]) -> [];
nonl([H|T]) -> [H|nonl(T)].

timeit(Name, Fun, St0) ->
    Time = runtime,
    %% Time = wall_clock,
    {Before, _} = statistics(Time),
    St = Fun(St0), 
    {After, _} = statistics(Time),
    Mem0 = erts_debug:flat_size(St)*erlang:system_info(wordsize),
    Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])),
    Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])),
    io:fwrite(" ~-30w: ~10.2f s ~12s ~10s\n", 
              [Name, (After-Before)/1000, Mem, Sz]),
    St.

-define(PASS(P), {P, fun P/1}).

generate(St0) ->
    St1 = output_encoding_comment(St0),
    Passes = [?PASS(parse_grammar), ?PASS(check_grammar),
              ?PASS(states_and_goto_table), ?PASS(parse_actions),
              ?PASS(action_conflicts), ?PASS(write_file)],
    F = case member(time, St1#yecc.options) of
            true -> 
                io:fwrite(<<"Generating parser from grammar in ~ts\n">>,
                          [format_filename(St1#yecc.infile, St1)]),
                fun timeit/3;
            false ->
                fun(_Name, Fn, St) -> Fn(St) end
        end,
    Fun = fun({Name, Fun}, St) ->
                  St2 = F(Name, Fun, St),
                  if 
                      St2#yecc.errors =:= [] -> St2;
                      true -> throw(St2)
                  end
          end,
    foldl(Fun, St1, Passes).

parse_grammar(St) ->
    StartLocation =
        case lists:keyfind(error_location, 1, St#yecc.options) of
            {error_location, column} ->
                {1, 1};
            _ ->
                1
        end,
    parse_grammar(St#yecc.inport, StartLocation, St).

parse_grammar(Inport, Location, St) ->
    {NextLocation, Grammar} = read_grammar(Inport, St, Location),
    parse_grammar(Grammar, Inport, NextLocation, St).

parse_grammar(eof, _Inport, _NextLocation, St) ->
    St;
parse_grammar({#symbol{name = 'Header'}, Ss}, Inport, NextLocation, St0) ->
    St1 = St0#yecc{header = [S || {string,_,S} <- Ss]},
    parse_grammar(Inport, NextLocation, St1);
parse_grammar({#symbol{name = 'Erlang'}, [#symbol{name = code}]}, _Inport, 
              NextLocation, St) ->
    St#yecc{erlang_code = line_of_location(NextLocation)};
parse_grammar(Grammar, Inport, NextLocation, St0) ->
    St = parse_grammar(Grammar, St0),
    parse_grammar(Inport, NextLocation, St).

parse_grammar({error,ErrorLocation,Error}, St) ->
    add_error(erl_anno:new(ErrorLocation), Error, St);
parse_grammar({rule, Rule, Tokens, AllTokens}, St0) ->
    NmbrOfDaughters = case Rule of
                          [_, #symbol{name = '$empty'}]  -> 0;
                          _ -> length(Rule) - 1
                      end,
    {IsGuard, IsWellFormed} = check_action(Tokens),
    {Tokens1, St} = subst_pseudo_vars(AllTokens,
                                      NmbrOfDaughters,
                                      St0),
    RuleDef = #rule{symbols = Rule, 
                    tokens = Tokens1, 
                    is_guard = IsGuard, 
                    is_well_formed = IsWellFormed},
    St#yecc{rules_list = [RuleDef | St#yecc.rules_list]};
parse_grammar({prec, Prec}, St) ->
    St#yecc{prec = Prec ++ St#yecc.prec};
parse_grammar({#symbol{}, [{string,Anno,String}]}, St) ->
    add_error(Anno, {bad_symbol, String}, St);
parse_grammar({#symbol{anno = Anno, name = Name}, Symbols}, St) ->
    CF = fun(I) ->
                 case element(I, St) of
                     [] -> 
                         setelement(I, St, Symbols);
                     _ -> 
                         add_error(Anno, {duplicate_declaration, Name}, St)
                 end
         end,
    OneSymbol = length(Symbols) =:= 1,
    case Name of
        'Nonterminals' -> CF(#yecc.nonterminals);
        'Terminals' -> CF(#yecc.terminals);
        'Rootsymbol' when OneSymbol -> CF(#yecc.rootsymbol);
        'Endsymbol' when OneSymbol ->  CF(#yecc.endsymbol);
        'Expect' when OneSymbol -> CF(#yecc.expect_shift_reduce);
        'States' when OneSymbol -> CF(#yecc.expect_n_states); % undocumented
        _ -> add_warning(Anno, bad_declaration, St)
    end.

read_grammar(Inport, St, Location) ->
    case yeccscan:scan(Inport, '', Location) of
        {eof, NextLocation} ->
            {NextLocation, eof};
        {error, {ErrorLocation, Mod, What}, NextLocation} ->
            {NextLocation, {error, ErrorLocation, {error, Mod, What}}};
        {error, terminated} ->
            throw(St);
        {error, _} ->
            File = St#yecc.infile,
            throw(add_error(File, none, cannot_parse, St));
        {ok, AllInput, Input, NextLocation} ->
            {NextLocation,
             case yeccparser:parse(Input) of
                 {error, {ErrorLocation, Mod, Message}} ->
                     {error, ErrorLocation, {error, Mod, Message}};
                 {ok, {rule, Rule, {erlang_code, Tokens}}} ->
                     AllTokens0 =
                         lists:dropwhile(fun(T) -> element(1, T) =/= ':' end,
                                         AllInput),
                     AllTokens = case AllTokens0 of
                                     [] ->
                                         Tokens;
                                     _ -> % Remove ':' and dot.
                                         tl(AllTokens0) -- [last(AllTokens0)]
                                 end,
                     {rule, Rule, Tokens, AllTokens};
                 {ok, {#symbol{name=P},
                       [#symbol{name=I} | OpL]}=Ss} ->
                     A = precedence(P),
                     if
                         A =/= unknown,
                         is_integer(I),
                         OpL =/= [] ->
                             Ps = [{Op, I , A} || Op <- OpL],
                             {prec, Ps};
                         true ->
                             Ss
                     end;
                 {ok, Ss} ->
                     Ss
             end}
    end.

precedence('Left') -> left;
precedence('Right') -> right;
precedence('Unary') -> unary;
precedence('Nonassoc') -> nonassoc;
precedence(_) -> unknown.

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

check_grammar(St0) ->
    Empty = #symbol{anno = none, name = '$empty'},
    AllSymbols = St0#yecc.nonterminals ++ St0#yecc.terminals ++ [Empty],
    St1 = St0#yecc{all_symbols = AllSymbols},
    Cs = [fun check_nonterminals/1, fun check_terminals/1, 
          fun check_rootsymbol/1, fun check_endsymbol/1, 
          fun check_expect/1, fun check_states/1,
          fun check_precedences/1, fun check_rules/1],
    foldl(fun(F, St) -> F(St) end, St1, Cs).

check_nonterminals(St) ->
    case St#yecc.nonterminals of 
        [] ->
            add_error(nonterminals_missing, St);
        Nonterminals ->
            {Unique, Dups} = duplicates(names(Nonterminals)),
            St1 = add_warnings(Dups, duplicate_nonterminal, St),
            St2 = check_reserved(Unique, St1),
            St2#yecc{nonterminals = [?ACCEPT | Unique]}
    end.

check_terminals(St0) ->
    case St0#yecc.terminals of
        [] ->
            add_error(terminals_missing, St0);
        Terminals ->
            {Unique, Dups} = duplicates(names(Terminals)),
            St1 = add_warnings(Dups, duplicate_terminal, St0),
            Common = intersect(St1#yecc.nonterminals, Unique),
            St2 = add_errors(Common, symbol_terminal_and_nonterminal, St1),
            St3 = check_reserved(Unique, St2),
            St3#yecc{terminals = ['$empty' | Unique]}
    end.

check_reserved(Names, St) ->
    add_errors(intersect(Names, ['$empty', '$end', '$undefined']),
               reserved, St).

check_rootsymbol(St) ->
    case St#yecc.rootsymbol of
        [] ->
            add_error(rootsymbol_missing, St);
        [#symbol{anno = Anno, name = SymName}] ->
            case kind_of_symbol(St, SymName) of
                nonterminal ->
                    St#yecc{rootsymbol = SymName};
                _ ->
                    add_error(Anno, {bad_rootsymbol, SymName}, St)
            end
    end.

check_endsymbol(St) ->
    case St#yecc.endsymbol of
        [] ->
            St#yecc{endsymbol = '$end'};
        [#symbol{anno = Anno, name = SymName}] ->
            case kind_of_symbol(St, SymName) of
                nonterminal ->
                    add_error(Anno, {endsymbol_is_nonterminal, SymName}, St);
                terminal ->
                    add_error(Anno, {endsymbol_is_terminal, SymName}, St);
                _ ->
                    St#yecc{endsymbol = SymName}
            end
    end.

check_expect(St0) ->
    case St0#yecc.expect_shift_reduce of
        [] ->
            St0#yecc{expect_shift_reduce = 0};
        [#symbol{name = Expect}] when is_integer(Expect) ->
            St0#yecc{expect_shift_reduce = Expect};
        [#symbol{anno = Anno, name = Name}] ->
            St1 = add_error(Anno, {bad_expect, Name}, St0),
            St1#yecc{expect_shift_reduce = 0}
    end.

check_states(St) ->
    case St#yecc.expect_n_states of
        [] ->
            St;
        [#symbol{name = NStates}] when is_integer(NStates) ->
            St#yecc{expect_n_states = NStates};
        [#symbol{anno = Anno, name = Name}] ->
            add_error(Anno, {bad_states, Name}, St)
    end.

check_precedences(St0) ->
    {St1, _} = 
        foldr(fun({#symbol{anno = Anno, name = Op},_I,_A}, {St,Ps}) ->
                      case member(Op, Ps) of
                          true ->
                              {add_error(Anno, {duplicate_precedence,Op}, St),
                               Ps};
                          false ->
                              {St, [Op | Ps]}
                      end
              end, {St0,[]}, St0#yecc.prec),
    foldl(fun({#symbol{anno = Anno, name = Op},I,A}, St) ->
                  case kind_of_symbol(St, Op) of
                      endsymbol ->
                          add_error(Anno,{precedence_op_is_endsymbol,Op}, St);
                      unknown ->
                          add_error(Anno, {precedence_op_is_unknown, Op}, St);
                      _ -> 
                          St#yecc{prec = [{Op,I,A} | St#yecc.prec]}
                  end
          end, St1#yecc{prec = []}, St1#yecc.prec).

check_rule(Rule0, {St0,Rules}) ->
    Symbols = Rule0#rule.symbols,
    #symbol{anno = HeadAnno, name = Head} = hd(Symbols),
    case member(Head, St0#yecc.nonterminals) of
        false -> 
            {add_error(HeadAnno, {undefined_nonterminal, Head}, St0), Rules};
        true ->
            St = check_rhs(tl(Symbols), St0),
            Rule = Rule0#rule{location = location(HeadAnno),
                              symbols = names(Symbols)},
            {St, [Rule | Rules]}
    end.

check_rules(St0) ->
    {St,Rules0} = foldl(fun check_rule/2, {St0,[]}, St0#yecc.rules_list),
    case St#yecc.rules_list of
        [] ->
            add_error(no_grammar_rules, St);
        _ ->
            Rule = #rule{location = none,
                         symbols = [?ACCEPT, St#yecc.rootsymbol],
                         tokens = []},
            Rules1 = [Rule | Rules0],
            Rules = map(fun({R,I}) -> R#rule{n = I} end,  count(0, Rules1)),
            St#yecc{rules_list = Rules, rules = list_to_tuple(Rules)}
    end.

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

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

symbol_anno(Name, St) ->
    #symbol{anno = Anno} = symbol_find(Name, St#yecc.all_symbols),
    Anno.

symbol_member(Symbol, Symbols) ->
    symbol_find(Symbol#symbol.name, Symbols) =/= false.

symbol_find(Name, Symbols) ->
    lists:keyfind(Name, #symbol.name, Symbols).

states_and_goto_table(St0) ->
    St1 = create_symbol_table(St0),
    St = compute_states(St1),
    create_precedence_table(St).

parse_actions(St) ->
    _ = erase(), % the pd is used when decoding lookahead sets
    ParseActions = compute_parse_actions(St#yecc.n_states, St, []),
    _ = erase(),
    St#yecc{parse_actions = ParseActions, state_tab = []}.

action_conflicts(St0) ->
    St = find_action_conflicts(St0),
    St#yecc{conflicts_done = true}.

-record(state_info, {reduce_only, state_repr, comment}).

write_file(St0) ->
    #yecc{parse_actions = ParseActions, goto_tab = GotoTab} = St0,
    Sorted = sort_parse_actions(ParseActions),
    StateReprs = find_identical_shift_states(Sorted),
    StateInfo = collect_some_state_info(Sorted, StateReprs),
    StateJumps = find_partial_shift_states(Sorted, StateReprs),
    UserCodeActions = find_user_code(Sorted, St0),
    #yecc{infile = Infile, outfile = Outfile,
          inport = Inport, outport = Outport,
          nonterminals = Nonterminals} = St0,
    {St10, N_lines, LastErlangCodeLine} = 
        output_prelude(Outport, Inport, St0),
    St20 = St10#yecc{line = St10#yecc.line + N_lines},
    St25 = nl(St20),
    St30 = output_file_directive(St25, Outfile, St25#yecc.line),
    St40 = nl(St30),
    St50 = output_actions(St40, StateJumps, StateInfo),
    Go0 = [{Symbol,{From,To}} || {{From,Symbol},To} <- ets:tab2list(GotoTab)],
    Go = family_with_domain(Go0, Nonterminals),
    St60 = output_goto(St50, Go, StateInfo),
    St70 = output_inlined(St60, UserCodeActions, Infile),
    St = nl(St70),
    case LastErlangCodeLine of
        %% Just in case warnings or errors are emitted after the last
        %% line of the file.
        {last_erlang_code_line, Last_line} ->
            output_file_directive(St, Infile, Last_line);
        no_erlang_code ->
            St
    end.

yecc_ret(St0) ->
    St = check_expected(St0),
    report_errors(St),
    report_warnings(St),
    Es = pack_errors(St#yecc.errors),
    Ws = pack_warnings(St#yecc.warnings),
    Werror = werror(St),
    if 
        Werror ->
            do_error_return(St, Es, Ws);
        Es =:= [] -> 
            case member(return_warnings, St#yecc.options) of
                true -> {ok, St#yecc.outfile, Ws};
                false -> {ok, St#yecc.outfile}
            end;
        true -> 
            do_error_return(St, Es, Ws)
    end.

do_error_return(St, Es, Ws) ->
    case member(return_errors, St#yecc.options) of
        true -> {error, Es, Ws};
        false -> error
    end.

check_expected(St0) ->
    #yecc{shift_reduce = SR, reduce_reduce = RR, expect_shift_reduce = ExpSR,
          n_states = NStates0, expect_n_states = ExpStates,
          conflicts_done = Done} = St0,
    N_RR = length(usort(RR)),
    N_SR = length(usort(SR)),
    St1 = if
              not Done ->
                  St0;
              N_SR =:= ExpSR, N_RR =:= 0 ->
                  St0;
              true ->
                  add_warning(none, {conflicts, N_SR, N_RR}, St0)
          end,
    NStates = NStates0 + 1,
    if
        (not Done) or (ExpStates =:= []) or (NStates =:= ExpStates) ->
            St1;
        true ->
            add_warning(none, {n_states, ExpStates, NStates}, St1)
    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(St) ->
    case member(report_errors, St#yecc.options) of
        true ->
            foreach(fun({File,{none,Mod,E}}) -> 
                            io:fwrite(<<"~ts: ~ts\n">>,
                                      [File,Mod:format_error(E)]);
                       ({File,{Location,Mod,E}}) ->
                            io:fwrite(<<"~ts:~s: ~ts\n">>,
                                      [File,pos(Location),Mod:format_error(E)])
                    end, sort(St#yecc.errors));
        false -> 
            ok
    end.

report_warnings(St) ->
    Werror = member(warnings_as_errors, St#yecc.options),
    Prefix = case Werror of
		 true -> "";
		 false -> "Warning: "
	     end,
    ReportWerror = Werror andalso member(report_errors, St#yecc.options),
    case member(report_warnings, St#yecc.options) orelse ReportWerror of
        true ->
            foreach(fun({File,{none,Mod,W}}) -> 
                            io:fwrite(<<"~ts: ~s~ts\n">>,
                                      [File,Prefix,
				       Mod:format_error(W)]);
                       ({File,{Location,Mod,W}}) ->
                            io:fwrite(<<"~ts:~s: ~s~ts\n">>,
                                      [File,pos(Location),Prefix,
				       Mod:format_error(W)])
                    end, sort(St#yecc.warnings));
        false -> 
            ok
    end.

pos(Line) when is_integer(Line) ->
    io_lib:format("~w", [Line]);
pos({Line, Column}) when is_integer(Line), is_integer(Column) ->
    io_lib:format("~w:~w", [Line, Column]).

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

add_error(Anno, E, St) ->
    add_error(St#yecc.infile, Anno, E, St).

add_error(File, Anno, E, St) ->
    Loc = location(Anno),
    St#yecc{errors = [{File,{Loc,?MODULE,E}}|St#yecc.errors]}.

add_errors(SymNames, E0, St0) ->
    foldl(fun(SymName, St) ->
                  add_error(symbol_anno(SymName, St), {E0, SymName}, St)
          end, St0, SymNames).

add_warning(Anno, W, St) ->
    Loc = location(Anno),
    St#yecc{warnings = [{St#yecc.infile,{Loc,?MODULE,W}}|St#yecc.warnings]}.

add_warnings(SymNames, W0, St0) ->
    foldl(fun(SymName, St) ->
                  add_warning(symbol_anno(SymName, St), {W0, SymName}, St)
          end, St0, SymNames).

check_rhs([#symbol{name = '$empty'}], St) ->
    St;
check_rhs(Rhs, St0) ->
    case symbol_find('$empty', Rhs) of
        #symbol{anno = Anno} ->
            add_error(Anno, illegal_empty, St0);
        false ->
            foldl(fun(Sym, St) ->
                          case symbol_member(Sym, St#yecc.all_symbols) of
                              true -> 
                                  St;
                              false -> 
                                  E = {undefined_symbol,Sym#symbol.name},
                                  add_error(Sym#symbol.anno, E, St)
                          end
                  end, St0, Rhs)
    end.

check_action(Tokens) ->
    case erl_parse:parse_exprs(add_roberts_dot(Tokens, erl_anno:new(0))) of
        {error, _Error} ->
            {false, false};
        {ok, [Expr | Exprs]} ->
            IsGuard = Exprs =:= [] andalso erl_lint:is_guard_test(Expr),
            {IsGuard, true}
    end.

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

-define(PSEUDO_PREFIX, "___").
-define(PSEUDO_VAR_1, '___1').

subst_pseudo_vars([], _, St) ->
    {[], St};
subst_pseudo_vars([H0 | T0], NmbrOfDaughters, St0) ->
    {H, St1} = subst_pseudo_vars(H0, NmbrOfDaughters, St0),
    {T, St} = subst_pseudo_vars(T0, NmbrOfDaughters, St1),
    {[H | T], St};
subst_pseudo_vars({atom, Anno, Atom}, NmbrOfDaughters, St0) ->
    case atom_to_list(Atom) of
        [$$ | Rest] ->
            try list_to_integer(Rest) of
                N when N > 0, N =< NmbrOfDaughters ->
                    PseudoVarName = append(?PSEUDO_PREFIX, Rest),
                    NewAnno = erl_anno:set_text(PseudoVarName, Anno),
                    {{var, NewAnno, list_to_atom(PseudoVarName)}, St0};
                _ ->
                    St = add_error(Anno,
                                   {undefined_pseudo_variable, Atom},
                                   St0),
                    {{atom, Anno, '$undefined'}, St}
            catch 
                error: _ -> {{atom, Anno, Atom}, St0}
            end;
        _ ->
            {{atom, Anno, Atom}, St0}
    end;
subst_pseudo_vars(Tuple, NmbrOfDaughters, St0) when is_tuple(Tuple) ->
    {L, St} = subst_pseudo_vars(tuple_to_list(Tuple), NmbrOfDaughters, St0),
    {list_to_tuple(L), St};
subst_pseudo_vars(Something_else, _, St) ->
    {Something_else, St}.

kind_of_symbol(St, SymName) ->
    case member(SymName, St#yecc.nonterminals) of
        false ->
            case member(SymName, St#yecc.terminals) of
                false ->
                    case St#yecc.endsymbol of
                        SymName ->
                            endsymbol;
                        _ ->
                            unknown
                    end;
                true ->
                    terminal
            end;
        true ->
            nonterminal
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Computing parse states and goto table from grammar.
% Start item: {0, [Endsymbol]} <->
% (['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.

-record(tabs, {
          symbols,      % ETS-set, keypos 1: {SymbolName, SymbolCode}
          inv_symbols,  % ETS-set, keypos 2: {SymbolName, SymbolCode}
          state_id,     % ETS-bag, keypos 1: {StateId, StateNum}
                        % StateId is not unique for a state.
          rp_rhs,       % rule pointer -> the remaining rhs symbols
          rp_info,      % rule pointer -> expanding rules and lookahead
          goto          % ETS-bag, keypos 1: first 
                        % {{FromStateNum, Symbol, ToStateNum}}, then
                        % {{FromStateNum, Symbol}, ToStateNum}
         }).

-record(item, { % what states are made of
          rule_pointer,
          look_ahead,
          rhs
         }).

compute_states(St0) ->
    SymbolTab = St0#yecc.symbol_tab,
    CodedRules = map(fun(#rule{symbols = Syms} = R) ->
                             R#rule{symbols = code_symbols(Syms, SymbolTab)}
                     end, St0#yecc.rules_list),
    CodedNonterminals = code_symbols(St0#yecc.nonterminals, SymbolTab),
    %% Only coded in this phase; StC is thrown away.
    StC = St0#yecc{rules_list = CodedRules, 
                   rules = list_to_tuple(CodedRules),
                   nonterminals = CodedNonterminals},
    {RuleIndex, RulePointer2Rule} = 
        make_rule_index(StC, St0#yecc.rules_list),
    StateTab0 = {},
    StateIdTab = ets:new(yecc_state_id, [set]),
    GotoTab = ets:new(yecc_goto, [bag]),
    RulePointerRhs = make_rhs_index(StC#yecc.rules_list),
    RulePointerInfo = make_rule_pointer_info(StC, RulePointerRhs, RuleIndex),

    Tables = #tabs{symbols = SymbolTab, 
                   state_id = StateIdTab,
                   rp_rhs = RulePointerRhs,
                   rp_info = RulePointerInfo,
                   goto = GotoTab},

    _ = erase(),
    EndsymCode = code_terminal(StC#yecc.endsymbol, StC#yecc.symbol_tab),
    {StateId, State0} = compute_state([{EndsymCode, 1}], Tables),

    StateNum0 = first_state(),
    FirstState = {StateNum0, State0},
    StateTab1 = insert_state(Tables, StateTab0, FirstState, StateId),
    {StateTab, N} = 
        compute_states1([{StateNum0, get_current_symbols(State0)}], 
                        FirstState, StateTab1, Tables),
    true = ets:delete(StateIdTab),
    St = St0#yecc{state_tab = StateTab, goto_tab = GotoTab, n_states = N,
                  rule_pointer2rule = RulePointer2Rule},
    decode_goto(GotoTab, St#yecc.inv_symbol_tab),
    check_usage(St).

first_state() ->
    0.

decode_goto(GotoTab, InvSymTab) ->
    G = ets:tab2list(GotoTab),
    ets:delete_all_objects(GotoTab),
    ets:insert(GotoTab, 
               map(fun({{From, Sym, Next}}) ->
                           {{From, decode_symbol(Sym, InvSymTab)}, Next}
                   end, G)).

check_usage(St0) ->
    SelSyms = ets:fun2ms(fun({{_,Sym},_}) -> Sym end),
    UsedSymbols = ets:select(St0#yecc.goto_tab, SelSyms),
    Syms = ordsets:from_list([?ACCEPT, '$empty' | UsedSymbols]),
    NonTerms = ordsets:from_list(St0#yecc.nonterminals),
    UnusedNonTerms = ordsets:to_list(ordsets:subtract(NonTerms, Syms)),
    St1 = add_warnings(UnusedNonTerms, unused_nonterminal, St0),
    Terms = ordsets:from_list(St0#yecc.terminals),
    St2 = add_warnings(ordsets:to_list(ordsets:subtract(Terms, Syms)),
                       unused_terminal, St1),
    DefinedNonTerminals = map(fun(#rule{symbols = [Name | _]}) -> 
                                            Name
                              end, St2#yecc.rules_list),
    DefNonTerms = ordsets:from_list(DefinedNonTerminals),
    UndefNonTerms = ordsets:subtract(NonTerms, DefNonTerms),
    add_errors(ordsets:to_list(ordsets:subtract(UndefNonTerms, 
                                                UnusedNonTerms)),
               missing_syntax_rule, St2).

%% States are sometimes big, should not be copied to ETS tables.
%% Here an "extendible" tuple is used.
lookup_state(StateTab, N) ->
    element(N+1, StateTab).

insert_state(#tabs{state_id = StateIdTab}, StateTab0, State, StateId) ->
    {N, _Items} = State,
    insert_state_id(StateIdTab, N, StateId),
    StateTab = if 
                   tuple_size(StateTab0) > N ->
                       StateTab0;
                   true ->
                       list_to_tuple(tuple_to_list(StateTab0) ++
                                     lists:duplicate(round(1 + N * 1.5), []))
               end,
    setelement(N+1, StateTab, State).

insert_state_id(StateIdTab, N, StateId) ->
    true = ets:insert(StateIdTab, {StateId, N}).

compute_states1([], {N, _}=_CurrState, StateTab0, _Tables) ->
    {StateTab0, N};
compute_states1([{N, Symbols} | Try], CurrState, StateTab, Tables) ->
    {_N, S} = lookup_state(StateTab, N),
    Seeds = state_seeds(S, Symbols),
    compute_states2(Seeds, N, Try, CurrState, StateTab, Tables).

compute_states2([], _N, Try, CurrState, StateTab, Tables) ->
    compute_states1(Try, CurrState, StateTab, Tables);
compute_states2([{Sym,Seed} | Seeds], N, Try, CurrState, StateTab, Tables) ->
    {StateId, NewState} = compute_state(Seed, Tables),
    case check_states(NewState, StateId, StateTab, Tables) of
        add ->
            {M, _} = CurrState,
            %% io:fwrite(<<"Adding state ~w\n">>, [M + 1]),
            CurrentSymbols = get_current_symbols(NewState),
            Next = M + 1,
            NextState = {Next, NewState},
            NewStateTab = insert_state(Tables, StateTab, NextState, StateId),
            insert_goto(Tables, N, Sym, Next),
            compute_states2(Seeds, N, [{Next, CurrentSymbols} | Try],
                            NextState, NewStateTab, Tables);
        {old, M} ->
            %% io:fwrite(<<"Identical to old state ~w\n">>, [M]),
            insert_goto(Tables, N, Sym, M),
            compute_states2(Seeds, N, Try, CurrState, StateTab, Tables);
        {merge, M, NewCurrent} ->
            %% io:fwrite(<<"Merging with state ~w\n">>, [M]),
            Try1 = case lists:keyfind(M, 1, Try) of
                       false ->
                           [{M, NewCurrent} | Try];
                       {_, OldCurrent} ->
                           case ordsets:is_subset(NewCurrent, OldCurrent) of
                               true ->
                                   Try;
                               false ->
                                   [{M, ordsets:union(NewCurrent, OldCurrent)}
                                    | keydelete(M, 1, Try)]
                           end
                   end,
            NewStateTab = merge_states(NewState, StateTab, Tables, M,StateId),
            insert_goto(Tables, N, Sym, M),
            compute_states2(Seeds, N, Try1, CurrState, NewStateTab, Tables)
    end.

insert_goto(Tables, From, Sym, To) ->
    true = ets:insert(Tables#tabs.goto, {{From, Sym, To}}).

%% Create an ets table for faster lookups.
create_symbol_table(St) ->
    #yecc{terminals = Terminals, endsymbol = Endsymbol} = St,
    SymbolTab = ets:new(yecc_symbols, [{keypos,1}]),
    %% '$empty' is always assigned 0
    Ts = ['$empty', Endsymbol | delete('$empty', Terminals)],
    TsC = count(0, Ts),
    NTsC = map(fun({NT,I}) -> {NT,-I} end, count(1, St#yecc.nonterminals)),
    Cs = TsC++NTsC,
    true = ets:insert(SymbolTab, Cs),

    InvSymTable = ets:new(yecc_inverted_terminals, [{keypos,2}]),
    true = ets:insert(InvSymTable, Cs),

    St#yecc{symbol_tab = SymbolTab, inv_symbol_tab = InvSymTable}.

get_current_symbols(State) ->
    usort(get_current_symbols1(State, [])).

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

state_seeds(Items, Symbols) ->
    L = [{S,{LA,RP + 1}} || #item{rule_pointer = RP, look_ahead = LA, 
                                  rhs = [S | _]} <- Items],
    state_seeds1(keysort(1, L), Symbols).

state_seeds1(_L, []) ->
    [];
state_seeds1(L, [Symbol | Symbols]) ->
    state_seeds(L, Symbol, Symbols, []).

state_seeds([{Symbol, Item} | L], Symbol, Symbols, Is) ->
    state_seeds(L, Symbol, Symbols, [Item | Is]);
state_seeds([{S, _Item} | L], Symbol, Symbols, Is) when S < Symbol ->
    state_seeds(L, Symbol, Symbols, Is);
state_seeds(L, Symbol, Symbols, Is) ->
    [{Symbol, Is} | state_seeds1(L, Symbols)].

compute_state(Seed, Tables) ->
    RpInfo = Tables#tabs.rp_info,
    foreach(fun({LA, RulePointer}) -> put(RulePointer, LA) end, Seed),
    foreach(fun({LA, RP}) -> compute_closure(LA, RP, RpInfo) end, Seed),
    Closure = keysort(1, erase()),
    state_items(Closure, [], [], Tables#tabs.rp_rhs).

%% Collects a unique id for the state (all rule pointers). 
state_items([{RP, LA} | L], Is, Id, RpRhs) ->
    I = #item{rule_pointer = RP, look_ahead = LA, rhs = element(RP, RpRhs)},
    state_items(L, [I | Is], [RP | Id], RpRhs);
state_items(_, Is, Id, _RpRhs) ->
    {Id, Is}.

-compile({inline,[compute_closure/3]}).
compute_closure(Lookahead, RulePointer, RpInfo) ->
    case element(RulePointer, RpInfo) of
        []=Void -> % no followers, or terminal
            Void;
        {no_union, ExpandingRules, NewLookahead} ->
            compute_closure1(ExpandingRules, NewLookahead, RpInfo);
        {union, ExpandingRules, Lookahead0} ->
            NewLookahead = set_union(Lookahead0, Lookahead),
            compute_closure1(ExpandingRules, NewLookahead, RpInfo);
        ExpandingRules ->
            compute_closure1(ExpandingRules, Lookahead, RpInfo)
    end.
    
compute_closure1([RulePointer | Tail], NewLookahead, RpInfo) ->
    compute_closure1(Tail, NewLookahead, RpInfo),
    case get(RulePointer) of
        undefined -> % New
            put(RulePointer, NewLookahead),
            compute_closure(NewLookahead, RulePointer, RpInfo);
        Lookahead2 ->
            Lookahead = set_union(Lookahead2, NewLookahead),
            if 
                Lookahead =:= Lookahead2 -> % Old
                    Lookahead2; % void()
                true -> % Merge
                    put(RulePointer, Lookahead),
                    compute_closure(NewLookahead, RulePointer, RpInfo)
            end
    end;
compute_closure1(Nil, _, _RpInfo) ->
    Nil.

%% Check if some old state is a superset of our NewState
check_states(NewState, StateId, StateTab, #tabs{state_id = StateIdTab}) ->
    try ets:lookup_element(StateIdTab, StateId, 2) of
        N ->
            {_N, OldState} = lookup_state(StateTab, N),
            check_state1(NewState, OldState, [], N)
    catch error:_ -> add
    end.

check_state1([#item{look_ahead = Lookahead1, rhs = Rhs} | Items1],
             [#item{look_ahead = Lookahead2} | Items2], Symbols, N) ->
    case set_is_subset(Lookahead1, Lookahead2) of
        true ->
            check_state1(Items1, Items2, Symbols, N);
        false ->
            case Rhs of
                [] ->
                    check_state2(Items1, Items2, Symbols, N);
                [Symbol | _] ->
                    check_state2(Items1, Items2, [Symbol | Symbols], N)
            end
    end;
check_state1([], [], _Symbols, N) ->
    {old, N}.

check_state2([#item{look_ahead = Lookahead1, rhs = Rhs} | Items1],
             [#item{look_ahead = Lookahead2} | Items2], Symbols, N) ->
    case set_is_subset(Lookahead1, Lookahead2) of
        true ->
            check_state2(Items1, Items2, Symbols, N);
        false ->
            case Rhs of
                [] ->
                    check_state2(Items1, Items2, Symbols, N);
                [Symbol | _] ->
                    check_state2(Items1, Items2, [Symbol | Symbols], N)
            end
    end;
check_state2([], [], Symbols, N) ->
    {merge, N, usort(Symbols)}.

merge_states(NewState, StateTab, Tables, M, StateId) ->
    {_M, Old_state} = lookup_state(StateTab, M),
    MergedState = merge_states1(NewState, Old_state),
    insert_state(Tables, StateTab, {M, MergedState}, StateId).

merge_states1([Item1 | Items1], [Item2 | Items2]) ->
    LA1 = Item1#item.look_ahead,
    LA2 = Item2#item.look_ahead,
    if
        LA1 =:= LA2 ->
            [Item1 | merge_states1(Items1, Items2)];
        true ->
            [Item1#item{look_ahead = set_union(LA1, LA2)}
             | merge_states1(Items1, Items2)]
    end;
merge_states1(_, _) ->
    [].

%% RulePointer -> Rhs. Every position Rhs in has its unique "rule pointer".
make_rhs_index(RulesList) ->
    Index = flatmap(fun(#rule{symbols = [_Non | Daughters]}) ->
                            suffixes0(Daughters)
                    end, RulesList),
    list_to_tuple(Index).

suffixes0([?EMPTY]) ->
    [[], []];
suffixes0(L) ->
    suffixes(L).

suffixes([]=L) ->
    [L];
suffixes([_ | T]=L) ->
    [L | suffixes(T)].

%% Setup info about lookahead and expanding rules for each point
%% ("rule pointer") in the grammar. 
make_rule_pointer_info(StC, RpRhs, RuleIndex) ->
    SymbolTab = StC#yecc.symbol_tab,
    LcTab = make_left_corner_table(StC),
    LA_index = map(fun(Syms) ->
                           rp_info(Syms, SymbolTab, LcTab, RuleIndex)
                   end, tuple_to_list(RpRhs)),
    list_to_tuple(LA_index).

rp_info([], _SymbolTab, _LcTab, _RuleIndex) ->
    [];
rp_info([Category | Followers], SymbolTab, LcTab, RuleIndex) ->
    case maps:find(Category, RuleIndex) of
        error -> % terminal
            [];
        {ok, ExpandingRules} when Followers =:= [] ->
            ExpandingRules;
        {ok, ExpandingRules} ->
            case make_lookahead(Followers, SymbolTab, LcTab, set_empty()) of
                {empty, LA} ->
                    {union, ExpandingRules, LA};
                LA ->
                    {no_union, ExpandingRules, LA}
            end
    end.

%% Lookahead computation is complicated by the possible existence
%% of null string rewriting rules, such as A -> '$empty'.
make_lookahead([], _, _, LA) ->
    {empty, LA};
make_lookahead([Symbol | Symbols], SymbolTab, LcTab, LA) ->
    case maps:find(Symbol, LcTab) of
        {ok, LeftCorner} -> % nonterminal
            case empty_member(LeftCorner) of
                true ->
                    make_lookahead(Symbols, SymbolTab, LcTab,
                                   set_union(empty_delete(LeftCorner), LA));
                false ->
                    set_union(LeftCorner, LA)
            end;
        error -> % terminal
            set_add(Symbol, LA)
    end.

%% -> map-of({Nonterminal, [Terminal]}).
%% The algorithm FIRST/1 from the Dragon Book.
%% Left corner table, all terminals (including '$empty') that can
%% begin strings generated by Nonterminal.
make_left_corner_table(#yecc{rules_list = RulesList} = St) ->
    SymbolTab = left_corner_symbol_table(St),
    Rules = map(fun(#rule{symbols = [Lhs | Rhs]}) ->
                        {Lhs,{Lhs, Rhs}}
                end, RulesList),
    LeftHandTab = maps:from_list(family(Rules)),
    X0 = [{S,H} || {H,{H,Rhs}} <- Rules, 
                   S <- Rhs, 
                   not is_terminal(SymbolTab, S)],
    XL = family_with_domain(X0, St#yecc.nonterminals),
    X = maps:from_list(XL),
    Xref = fun(NT) -> maps:get(NT, X) end,
    E = set_empty(),
    LC0 = maps:from_list([{H, E} || {H,_} <- XL]),
    %% Handle H -> a S, where a is a terminal ('$empty' inclusive).
    {Q, LC1} =
        foldl(fun({H,{H,[S | _]}}, {Q0, LC}) ->
                      case ets:lookup(SymbolTab, S) of
                          [{_,Num}=SymbolAndNum] when Num >= 0 ->
                              F = set_add_terminal(SymbolAndNum, E),
                              {[Xref(H) | Q0], upd_first(H, F, LC)};
                          _ ->
                              {Q0, LC}
                      end
              end, {[], LC0}, Rules),
    left_corners(Q, LC1, LeftHandTab, SymbolTab, Xref).

left_corners(Q0, LC0, LeftHandTab, SymbolTab, Xref) ->
    case usort(append(Q0)) of
        [] -> 
            LC0;
        Q1 -> 
            Rs = flatmap(fun(NT) -> maps:get(NT, LeftHandTab) end, Q1),
            {LC, Q} = left_corners2(Rs, LC0, [], SymbolTab, Xref),
            left_corners(Q, LC, LeftHandTab, SymbolTab, Xref)
    end.
    
left_corners2([], LC, Q, _SymbolTab, _Xref) ->
    {LC, Q};
left_corners2([{Head,Rhs} | Rs], LC, Q0, SymbolTab, Xref) ->
    Ts = left_corner_rhs(Rhs, Head, LC, set_empty(), SymbolTab),
    First0 = maps:get(Head, LC),
    case set_is_subset(Ts, First0) of
        true ->
            left_corners2(Rs, LC, Q0, SymbolTab, Xref);
        false ->
            LC1 = upd_first(Head, Ts, LC),
            left_corners2(Rs, LC1, [Xref(Head) | Q0], SymbolTab, Xref)
    end.

upd_first(NT, Ts, LC) ->
    maps:update_with(NT, fun(First) -> set_union(First, Ts) end, LC).

left_corner_rhs([S | Ss], Head, LC, Ts, SymbolTab) ->
    case ets:lookup(SymbolTab, S) of
        [{_,Num}=SymbolAndNum] when Num >= 0 ->
            set_add_terminal(SymbolAndNum, Ts);
        [_NonTerminalSymbol] ->
            First = maps:get(S, LC),
            case empty_member(First) of
                true ->
                    NTs = set_union(empty_delete(First), Ts),
                    left_corner_rhs(Ss, Head, LC, NTs, SymbolTab);
                false ->
                    set_union(First, Ts)
            end
    end;
left_corner_rhs([], _Head, _LC, Ts, _SymbolTab) ->
    set_add(?EMPTY, Ts).

%% For every non-terminal return a list of "rule pointers" for rules
%% expanding the non-terminal.
%% Also assigns a unique number to each point in the grammar, "rule pointer".
make_rule_index(#yecc{nonterminals = Nonterminals, 
                      rules_list = RulesList}, RulesListNoCodes) ->
    {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)],
    {maps:from_list(IndexedTab), maps: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 | _], _RuleLocation, _} ->
                    [{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], _RuleLocation, _} ->
                    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 | _], _RuleLocation, _} = 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([accept=A, #reduce{}=R | Rs], Cxt0) ->
    Confl = conflict(R, A, Cxt0),
    St = conflict_error(Confl, Cxt0#cxt.yecc), 
    Cxt = Cxt0#cxt{yecc = St},
    find_reduce_reduce([R | Rs], 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
%% almost arbitrarily. nonassoc has to come last, though (but is later
%% discarded!). And shift has to come before reduce.
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.

%% -> {State, StateRepr}. StateRepr has the same set of shift actions
%% as State. No code will be output for State if State =/= StateRepr.
find_identical_shift_states(StateActions) ->
    L1 = [{Actions, State} || {State,Actions} <- StateActions],
    {SO, NotSO} = lists:partition(fun({Actions,_States}) ->
                                          shift_actions_only(Actions)
                                  end, family(L1)),
    R = [{State, hd(States)} || {_Actions, States} <- SO, State <- States]
        ++ 
        [{State, State} || {_Actions, States} <- NotSO, State <- States],
    lists:keysort(1, R).

-record(part_data, {name, eq_state, actions, n_actions, states}).

%% Replace {SStates,Actions} with {SStates,{Actions,Jump}} where
%% Jump describes which clauses that have been extracted from shift
%% states so that they can be used from other states. Some space is
%% saved.
find_partial_shift_states(StateActionsL, StateReprs) ->
    L = [{State, Actions} || {{State,Actions}, {State,State}} <-
                                 lists:zip(StateActionsL, StateReprs),
                             shift_actions_only(Actions)],
    StateActions = sofs:family(L, [{state,[action]}]),
    StateAction = sofs:family_to_relation(StateActions),

    %% Two actions are equal if they occur in the same states:
    Parts = sofs:partition(sofs:range(StateActions)),
    PartsL = sofs:to_external(Parts),
    %% Assign temporary names to the parts of the partition (of actions):
    PartNameL = lists:zip(seq1(length(PartsL)), PartsL),
    ActPartL = [{Action,PartName} || 
                   {PartName,Actions} <- PartNameL,
                   Action <- Actions],
    ActionPartName = sofs:relation(ActPartL, [{action,partname}]),
    StatePartName = sofs:relative_product(StateAction, ActionPartName),
    PartInStates = sofs:relation_to_family(sofs:converse(StatePartName)),

    %% Parts that equal all actions of a state:
    PartActions = sofs:family(PartNameL, [{partname,[action]}]),
    PartState = 
        sofs:relative_product(PartActions, sofs:converse(StateActions)),
    PartStates = sofs_family_with_domain(PartState, sofs:domain(PartActions)),

    PartDataL = [#part_data{name = Nm, eq_state = EqS, actions = P, 
                            n_actions = length(P), 
                            states = ordsets:from_list(S)} || 
                    {{Nm,P}, {Nm,S}, {Nm,EqS}} <- 
                        lists:zip3(PartNameL, 
                                   sofs:to_external(PartInStates),
                                   sofs:to_external(PartStates))],
    true = length(PartDataL) =:= length(PartNameL),
    Ps = select_parts(PartDataL),

    J1 = [{State, Actions, {jump_some,hd(States)}} ||
             {_W, #part_data{actions = Actions, eq_state = [], 
                             states = States}} <- Ps,
             State <- States],
    J2 = [{State, Actions, {jump_all,To}} ||
             {_W, #part_data{actions = Actions, eq_state = EqS, 
                             states = States}} <- Ps,
             To <- EqS,
             State <- States,
             State =/= To],
    J = lists:keysort(1, J1 ++ J2),

    JumpStates = ordsets:from_list([S || {S,_,_} <- J]),
    {JS, NJS} = 
        sofs:partition(1, sofs:relation(StateActionsL, [{state, actions}]),
                       sofs:set(JumpStates, [state])),
    R = 
        [{S, {Actions,jump_none}} || {S,Actions} <- sofs:to_external(NJS)]
        ++
        [{S, {Actions--Part, {Tag,ToS,Part}}} || 
            {{S,Actions}, {S,Part,{Tag,ToS}}} <- 
                lists:zip(sofs:to_external(JS), J)],
    true = length(StateActionsL) =:= length(R),
    lists:keysort(1, R).

%% Very greedy. By no means optimal. 
select_parts([]) ->
    [];
select_parts(PartDataL) ->
    T1 = [{score(PD), PD} || PD <- PartDataL],
    [{W, PD} | Ws] = lists:reverse(lists:keysort(1, T1)),
    #part_data{n_actions = NActions, states = S} = PD,
    if
        W < 8 -> % don't bother
            [];
        true ->
            %% Cannot extract more clauses from the chosen part's states:
            NL = [D#part_data{states = NewS} || 
                     {W1, #part_data{states = S0}=D} <- Ws,
                     W1 > 0,
                     (NewS = ordsets:subtract(S0, S)) =/= []],
            if 
                length(S) =:= 1; NActions =:= 1 ->
                    select_parts(NL);
                true -> 
                    [{W,PD} | select_parts(NL)]
            end
    end.

%% Does it pay off to extract clauses into a new function?
%% Assumptions:
%% - a call costs 8 (C = 8);
%% - a clause (per action) costs 20 plus 8 (select) (Cl = 28);
%% - a new function costs 20 (funinfo) plus 16 (select) (F = 36).
%% A is number of actions, S is number of states.
%% Special case (the part equals all actions of some state):
%% C * (S - 1) < (S - 1) * A * Cl
%% Normal case (introduce new function):
%% F + A * Cl + C * S < S * A * Cl
score(#part_data{n_actions = NActions, eq_state = [], states = S}) ->
    (length(S) * NActions * 28) - (36 + NActions * 28 + length(S) * 8);
score(#part_data{n_actions = NActions, states = S}) ->
    ((length(S) - 1) * NActions * 28) - (8 * (length(S) - 1)).

shift_actions_only(Actions) ->
    length([foo || {_Ts,{shift,_,_,_,_}} <- Actions]) =:= length(Actions).

collect_some_state_info(StateActions, StateReprs) ->
    RF = fun({_LA, A}) -> is_record(A, reduce) end,
    L = [{State, 
          begin
              RO = lists:all(RF, LaActions),
              %% C is currently always ""; identical states are all shift.
              C = [io_lib:fwrite(<<" %% ~w\n">>, [State]) || 
                      true <- [RO], Repr =/= State],
              #state_info{reduce_only = RO, state_repr = Repr, comment = C}
          end} ||
            {{State, LaActions}, {State, Repr}} <-
                lists:zip(StateActions, StateReprs)],
    list_to_tuple(L).

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)]),
            Formatted = format_symbol(ActionName),
            case How of 
                prec ->
                    io:fwrite(<<"Resolved in favor of ~ts.\n\n">>, [Formatted]);
                default ->
                    io:fwrite(<<"Conflict resolved in favor of ~ts.\n\n">>, 
                              [Formatted])
            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, _, {accept, _}} ->
            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, RuleLocation1, RuleN1} = rule(RuleNmbr1, St),
    Confl = case NewAction of
                accept -> 
                    {accept, St#yecc.rootsymbol};
                #reduce{rule_nmbr = RuleNmbr2} -> 
                    {R2, RuleLocation2, RuleN2} = rule(RuleNmbr2, St),
                    {reduce, R2, RuleN2, RuleLocation2};
                #shift{state = NewState} ->
                    {shift, NewState, last(R1)}
            end,
    {Symbol, N, {R1, RuleN1, RuleLocation1}, 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 ~ts in state ~w:\n">>, 
                       [format_symbol(Symbol), N]),
    S2 = io_lib:fwrite(<<"   ~s ~w (rule ~w ~s)\n"
                          "      vs.\n">>,
                       [format_assoc(Ass1), P1, RuleN1, rule_pos(L1)]),
    S3 = io_lib:fwrite(<<"   ~s ~w (rule ~w ~s)\n">>,
                       [format_assoc(Ass2), P2, RuleN2, rule_pos(L2)]),
    [S1, S2, S3];
format_conflict({Symbol, N, Reduce, Confl}) ->
    S1 = io_lib:fwrite(<<"Parse action conflict scanning symbol "
                         "~ts in state ~w:\n">>, [format_symbol(Symbol), N]),
    S2 = case Reduce of
             {[HR | TR], RuleNmbr, RuleLocation} ->
                 io_lib:fwrite(<<"   Reduce to ~ts from ~ts (rule ~w "
                                 "~s)\n      vs.\n">>,
                               [format_symbol(HR), format_symbols(TR), 
                                RuleNmbr, rule_pos(RuleLocation)])
         end,
    S3 = case Confl of 
             {reduce, [HR2|TR2], RuleNmbr2, RuleLocation2} ->
                 io_lib:fwrite(<<"   reduce to ~ts from ~ts "
                                 "(rule ~w ~s).">>,
                               [format_symbol(HR2), format_symbols(TR2), 
                                RuleNmbr2, rule_pos(RuleLocation2)]);
             {shift, NewState, Sym} ->
                 io_lib:fwrite(<<"   shift to state ~w, adding right "
                                 "sisters to ~ts.">>,
                               [NewState, format_symbol(Sym)]);
             {accept, Rootsymbol} ->
                 io_lib:fwrite(<<"   reduce to rootsymbol ~ts.">>,
                               [format_symbol(Rootsymbol)])
         end,
    [S1, S2, S3].

rule_pos(Line) when is_integer(Line) ->
    io_lib:format("at line ~w", [Line]);
rule_pos({Line, Column}) when is_integer(Line), is_integer(Column) ->
    io_lib:format("at location ~w:~w", [Line, Column]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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 of 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.
%%
%% "1.2", parsetools-1.4.2:
%% - the generated code has been changed as follows:
%%   - yeccpars2() calls the functions yeccpars2_State();
%%   - several states can share yeccpars2_State(), which reduces code size;
%%   - yeccgoto() has been split on one function per nonterminal;
%%   - several minor changes have made the loaded code smaller.
%% - the include file yeccpre.hrl has been changed incompatibly.
%%
%% "1.3", parsetools-1.4.4:
%% - the generated code has been changed as follows:
%%   - yeccgoto_T() no longer returns the next state, but calls yeccpars_S();
%%   - yeccpars2() is not called when it is known which yeccpars2_S() to call;
%%   - "__Stack" has been substituted for "Stack";
%%   - several states can share yeccpars2_S_cont(), which reduces code size;
%%   - instead if calling lists:nthtail() matching code is emitted.
%%
%% "1.4", parsetools-2.0.4:
%% - yeccerror() is called when a syntax error is found (as in version 1.1).
%% - the include file yeccpre.hrl has been changed.

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

%% Returns number of newlines in included files.
output_prelude(Outport, Inport, St0) when St0#yecc.includefile =:= [] ->
    St5 = output_header(St0),
    #yecc{infile = Infile, module = Module} = St5,
    St8 = output_file_directive(St5, Infile, 0),
    St10 = fwrite(St8, <<"-module(~w).\n">>, [Module]),
    St15 = output_file_directive(St10, St10#yecc.outfile, St10#yecc.line),
    St20 = 
        fwrite(St15,
               <<"-export([parse/1, parse_and_scan/1, format_error/1]).\n">>,
               []),
    {St25, N_lines_1, LastErlangCodeLine} = 
        case St20#yecc.erlang_code of 
            none ->
                {St20, 0, no_erlang_code};
            Next_line ->
                St_10 = output_file_directive(St20, Infile, Next_line-1),
                Last_line = include1([], Inport, Outport, Infile,
                                     Next_line, St_10),
                Nmbr_of_lines = Last_line - Next_line,
                {St_10, Nmbr_of_lines, {last_erlang_code_line, Last_line}}
    end,
    St30 = nl(St25),
    IncludeFile = 
        filename:join([code:lib_dir(parsetools), "include","yeccpre.hrl"]),
    %% Maybe one could assume there are no warnings in this file.
    St = output_file_directive(St30, IncludeFile, 0),
    N_lines_2 = include(St, IncludeFile, Outport),
    {St, N_lines_1 + N_lines_2, LastErlangCodeLine};
output_prelude(Outport, Inport, St0) ->
    St5 = output_header(St0),
    #yecc{infile = Infile, module = Module, includefile = Includefile} = St5,
    St10 = fwrite(St5, <<"-module(~w).\n">>, [Module]),
    St20 = output_file_directive(St10, Includefile, 0),
    N_lines_1 = include(St20, Includefile, Outport),
    St30 = nl(St20),
    case St30#yecc.erlang_code of 
        none ->
            {St30, N_lines_1, no_erlang_code};
        Next_line ->
            St = output_file_directive(St30, Infile, Next_line-1),
            Last_line = include1([], Inport, Outport, Infile, Next_line, St),
            Nmbr_of_lines = Last_line - Next_line,
            {St, Nmbr_of_lines + N_lines_1, {last_erlang_code_line, Last_line}}
    end.

output_header(St0) ->
    lists:foldl(fun(Str, St) -> fwrite(St, <<"~ts\n">>, [Str])
                end, St0, St0#yecc.header).

output_goto(St, [{_Nonterminal, []} | Go], StateInfo) ->
    output_goto(St, Go, StateInfo);
output_goto(St0, [{Nonterminal, List} | Go], StateInfo) ->
    F = function_name(St0, yeccgoto, Nonterminal),
    St05 = output_nowarn(St0, F, '', 7),
    St10 = output_goto1(St05, List, F, StateInfo, true),
    St = output_goto_fini(F, Nonterminal, St10),
    output_goto(St, Go, StateInfo);
output_goto(St, [], _StateInfo) ->
    St.

output_goto1(St0, [{From, To} | Tail], F, StateInfo, IsFirst) ->
    St10 = delim(St0, IsFirst),
    {To, ToInfo} = lookup_state(StateInfo, To),
    #state_info{reduce_only = RO, state_repr = Repr, comment = C} = ToInfo,
    if
        RO -> 
            %% Reduce actions do not use the state, so we just pass
            %% the old (now bogus) on:
            FromS = io_lib:fwrite("~w=_S", [From]),
            ToS = "_S";
        true ->
            FromS = io_lib:fwrite("~w", [From]),
            ToS = io_lib:fwrite("~w", [To])
    end,
    St20 = fwrite(St10, <<"~w(~s, Cat, Ss, Stack, T, Ts, Tzr) ->\n">>, 
                  [F,FromS]),
    St30 = fwrite(St20, <<"~s">>, [C]),
    %% Short-circuit call to yeccpars2:
    St = fwrite(St30, <<" yeccpars2_~w(~s, Cat, Ss, Stack, T, Ts, Tzr)">>, 
                [Repr, ToS]),
    output_goto1(St, Tail, F, StateInfo, false);
output_goto1(St, [], _F, _StateInfo, _IsFirst) ->
    St.

output_goto_fini(F, NT, #yecc{includefile_version = {1,1}}=St0) ->
    %% Backward compatibility.
    St10 = delim(St0, false),
    St = fwrite(St10, <<"~w(State, _Cat, _Ss, _Stack, _T, _Ts, _Tzr) ->\n">>,
                [F]),
    fwrite(St, 
           ?YECC_BUG(<<"{~ts, State, missing_in_goto_table}">>,
                     [quoted_atom(NT)]),
           []);
output_goto_fini(_F, _NT, St) ->
    fwrite(St, <<".\n\n">>, []).

%% Find actions having user code.
find_user_code(ParseActions, St) ->
    [#user_code{state = State, 
                terminal = Terminal, 
                funname = inlined_function_name(St, State, Terminal),
                action = Action} || 
        {State, La_actions} <- ParseActions,
        {Action, Terminals, RuleNmbr, NmbrOfDaughters} 
            <- find_user_code2(La_actions),
        case tokens(RuleNmbr, St) of
            [{var, _, ?PSEUDO_VAR_1}] -> NmbrOfDaughters =/= 1;
            _ -> true
        end,
        Terminal <- Terminals].

find_user_code2([]) ->
    [];
find_user_code2([{_, #reduce{rule_nmbr = RuleNmbr,
                             nmbr_of_daughters = NmbrOfDaughters}
                  =Action}]) ->
    %% Same optimization as in output_state_actions.
    [{Action, ["Cat"], RuleNmbr, NmbrOfDaughters}];
find_user_code2([{La, #reduce{rule_nmbr = RuleNmbr,
                              nmbr_of_daughters = NmbrOfDaughters}
                  =Action} | T]) ->
    [{Action,La, RuleNmbr, NmbrOfDaughters} | find_user_code2(T)];
find_user_code2([_ | T]) ->
    find_user_code2(T).

output_actions(St0, StateJumps, StateInfo) ->
    %% Not all the clauses of the dispatcher function yeccpars2() can
    %% be reached. Only when shifting, that is, calling yeccpars1(),
    %% will yeccpars2() be called.
    Y2CL = [NewState || {_State,{Actions,J}} <- StateJumps,
                        {_LA, #shift{state = NewState}} <- 
                            (Actions
                             ++ [A || {_Tag,_To,Part} <- [J], A <- Part])],
    Y2CS = ordsets:from_list([0 | Y2CL]),
    Y2S = ordsets:from_list([S || {S,_} <- StateJumps]),
    NY2CS = ordsets:subtract(Y2S, Y2CS),
    Sel = [{S,true} || S <- ordsets:to_list(Y2CS)] ++
          [{S,false} || S <- ordsets:to_list(NY2CS)],

    SelS = [{State,Called} || 
               {{State,_JActions}, {State,Called}} <- 
                   lists:zip(StateJumps, lists:keysort(1, Sel))],
    St05 = output_nowarn(St0, yeccpars2, '', 7),
    St10 = foldl(fun({State, Called}, St_0) ->
                         {State, #state_info{state_repr = IState}} = 
                             lookup_state(StateInfo, State),
                         output_state_selection(St_0, State, IState, Called)
            end, St05, SelS),
    St20 = fwrite(St10, <<"yeccpars2(Other, _, _, _, _, _, _) ->\n">>, []),
    St = fwrite(St20,
                ?YECC_BUG(<<"{missing_state_in_action_table, Other}">>, []),
                []),
    foldl(fun({State, JActions}, St_0) ->
                  {State, #state_info{state_repr = IState}} = 
                      lookup_state(StateInfo, State),
                  output_state_actions(St_0, State, IState, 
                                       JActions, StateInfo)
          end, St, StateJumps).

output_state_selection(St0, State, IState, Called) ->
    Comment = [<<"%% ">> || false <- [Called]],
    St = fwrite(St0, <<"~syeccpars2(~w=S, Cat, Ss, Stack, T, Ts, Tzr) ->\n">>,
                [Comment, State]),
    fwrite(St, 
           <<"~s yeccpars2_~w(S, Cat, Ss, Stack, T, Ts, Tzr);\n">>, 
           [Comment, IState]).

output_state_actions(St, State, State, {Actions,jump_none}, SI) ->
    St1 = output_state_actions_begin(St, State, Actions),
    output_state_actions1(St1, State, Actions, true, normal, SI);
output_state_actions(St0, State, State, {Actions, Jump}, SI) ->
    {Tag, To, Common} = Jump,
    CS = case Tag of
             jump_some -> list_to_atom(lists:concat([cont_, To]));
             jump_all -> To
         end,
    St = output_state_actions1(St0, State, Actions, true, {to, CS}, SI),
    if 
        To =:= State ->
            St1 = output_state_actions_begin(St, State, Actions),
            output_state_actions1(St1, CS, Common, true, normal, SI);
        true ->
            St
    end;
output_state_actions(St, State, JState, _XActions, _SI) ->
    fwrite(St, <<"%% yeccpars2_~w: see yeccpars2_~w\n\n">>, [State, JState]).

output_state_actions_begin(St, State, _Actions) ->
    output_nowarn(St, yeccpars2_, State, 7).

output_state_actions1(St, State, [], IsFirst, normal, _SI) ->
    output_state_actions_fini(State, IsFirst, St);
output_state_actions1(St0, State, [], IsFirst, {to, ToS}, _SI) ->
    St = delim(St0, IsFirst),
    fwrite(St, 
           <<"yeccpars2_~w(S, Cat, Ss, Stack, T, Ts, Tzr) ->\n"
            " yeccpars2_~w(S, Cat, Ss, Stack, T, Ts, Tzr).\n\n">>,
           [State, ToS]);
output_state_actions1(St0, State, [{_, #reduce{}=Action}], 
                      IsFirst, _End, SI) ->
    St = output_reduce(St0, State, "Cat", Action, IsFirst, SI),
    fwrite(St, <<".\n\n">>, []);
output_state_actions1(St0, State, [{Lookahead,Action} | Tail],
                      IsFirst, End, SI) ->
    {_, St} = 
        foldl(fun(Terminal, {IsFst,St_0}) ->
                      {false,
                       output_action(St_0, State, Terminal, Action, IsFst,SI)}
              end, {IsFirst,St0}, Lookahead),
    output_state_actions1(St, State, Tail, false, End, SI).

output_action(St, State, Terminal, #reduce{}=Action, IsFirst, SI) ->
    output_reduce(St, State, Terminal, Action, IsFirst, SI);
output_action(St0, State, Terminal, #shift{state = NewState}, IsFirst, _SI) ->
    St10 = delim(St0, IsFirst),
    St = fwrite(St10, <<"yeccpars2_~w(S, ~ts, Ss, Stack, T, Ts, Tzr) ->\n">>,
                [State, quoted_atom(Terminal)]),
    output_call_to_includefile(NewState, St);
output_action(St0, State, Terminal, accept, IsFirst, _SI) ->
    St10 = delim(St0, IsFirst),
    St = fwrite(St10, 
                <<"yeccpars2_~w(_S, ~ts, _Ss, Stack, _T, _Ts, _Tzr) ->\n">>,
                [State, quoted_atom(Terminal)]),
    fwrite(St, <<" {ok, hd(Stack)}">>, []);
output_action(St, _State, _Terminal, nonassoc, _IsFirst, _SI) ->
    St.

output_call_to_includefile(NewState, #yecc{includefile_version = {1,1}}=St) ->
    %% Backward compatibility.
    fwrite(St, <<" yeccpars1(Ts, Tzr, ~w, [S | Ss], [T | Stack])">>, 
           [NewState]);
output_call_to_includefile(NewState, St) ->
    fwrite(St, <<" yeccpars1(S, ~w, Ss, Stack, T, Ts, Tzr)">>, 
           [NewState]).

output_state_actions_fini(State, IsFirst, St0) ->
    %% Backward compatible.
    St10 = delim(St0, IsFirst),
    St = fwrite(St10, <<"yeccpars2_~w(_, _, _, _, T, _, _) ->\n">>, [State]),
    fwrite(St, <<" yeccerror(T).\n\n">>, []).

output_reduce(St0, State, Terminal,
              #reduce{rule_nmbr = RuleNmbr, 
                      head = Head, 
                      nmbr_of_daughters = NmbrOfDaughters},
              IsFirst, StateInfo) ->
    St10 = delim(St0, IsFirst),
    QuotedTerminal = if 
                         is_atom(Terminal) -> quoted_atom(Terminal);
                         true -> Terminal
                     end,
    St20 = fwrite(St10,
                  <<"yeccpars2_~w(_S, ~ts, Ss, Stack, T, Ts, Tzr) ->\n">>,
                  [State, QuotedTerminal]),
    St30 = 
        if
            NmbrOfDaughters < 2 ->
                Ns = "Ss",
                St20;
            true ->
                Ns = "Nss",
                Tmp = lists:join(",",
                                  lists:duplicate(NmbrOfDaughters - 1, "_")),
                fwrite(St20, <<" [~s|Nss] = Ss,\n">>, [Tmp])
        end,
    St40 = case tokens(RuleNmbr, St30) of
               [{var, _, ?PSEUDO_VAR_1}] when NmbrOfDaughters =:= 1 ->
                   NewStack = "Stack",
                   St30;
               _ ->
                   NewStack = "NewStack",
                   fwrite(St30, <<" NewStack = ~w(Stack),\n">>, 
                          [inlined_function_name(St30, State, Terminal)])
               end,
    if 
        NmbrOfDaughters =:= 0 ->
            NextState = goto(State, Head, St40),
            {NextState, I} = lookup_state(StateInfo, NextState),
            #state_info{reduce_only = RO, state_repr = Repr, comment = C} = I,
            %% Reduce actions do not use the state, so we just pass
            %% the old (now bogus) on:
            if
                RO -> NextS = "_S";
                true -> NextS = io_lib:fwrite("~w", [NextState])
            end,
            St = fwrite(St40, <<"~s">>, [C]),
            %% Short-circuit call to yeccpars2:
            fwrite(St,
                   <<" yeccpars2_~w(~s, ~ts, [~w | Ss], ~s, T, Ts, Tzr)">>,
                   [Repr, NextS, QuotedTerminal, State, NewStack]);
        true ->
            fwrite(St40, 
                   <<" ~w(hd(~s), ~ts, ~s, ~s, T, Ts, Tzr)">>,
                   [function_name(St40, yeccgoto, Head), Ns,
                    QuotedTerminal, Ns, NewStack])
    end.

delim(St, true) ->
    St;
delim(St, false) ->
    fwrite(St, <<";\n">>, []).

%% Always quote atoms to ensure compatibility with future reserved words.
quoted_atom(Atom) when is_atom(Atom) ->
    case lists:flatten(io_lib:write_atom_as_latin1(Atom)) of
        "'" ++ _ = Quoted -> Quoted;
        NotQuoted -> ["'", NotQuoted, "'"]
    end.

output_inlined(St, UserCodeActions, Infile) ->
    foldl(fun(#user_code{funname = InlinedFunctionName, 
                         action = Action}, St_0) ->
                  output_inlined(St_0, InlinedFunctionName, 
                                 Action, Infile)
          end, St, UserCodeActions).

%% Each action with user code is placed in a separate inlined function.
%% The purpose is to be able to pinpoint errors and warnings correctly.
output_inlined(St0, FunctionName, Reduce, Infile) ->
    #reduce{rule_nmbr = RuleNmbr, nmbr_of_daughters = N_daughters} = Reduce,
    #rule{tokens = Tokens, is_well_formed = WF} = get_rule(RuleNmbr, St0),
    Line0 = first_line(Tokens),
    NLines = last_line(Tokens) - Line0,

    St5 = if 
              WF ->
                  St0;
              not WF -> 
                  %% The compiler will generate an error message for
                  %% the inlined function (unless the reason that yecc
                  %% failed to parse the action was some macro). The
                  %% line number of the message will be correct since
                  %% we are keeping track of the current line of the
                  %% output file...
                  #yecc{outfile = Outfile, line = CurLine} = St0,
                  output_file_directive(St0, Outfile, CurLine)
          end,

    CodeStartLine = lists:max([0, Line0 - 4]),
    St10 = fwrite(St5, <<"-compile({inline,~w/1}).\n">>, [FunctionName]),
    St15 = output_nowarn(St10, FunctionName, '', 1),
    St20 = output_file_directive(St15, Infile, CodeStartLine),
    St30 = fwrite(St20, <<"~w(__Stack0) ->\n">>, [FunctionName]),
    %% Currently the (old) inliner emits less code if matching the
    %% stack inside the body rather than in the head...
    St40 = case N_daughters of
               0 -> 
                   Stack = "__Stack0",
                   St30;
               _ -> 
                   Stack = "__Stack",
                   A = concat(flatmap(fun(I) -> [",",?PSEUDO_PREFIX,I] end,
                                      lists:seq(N_daughters, 1, -1))),
                   fwrite(St30, <<" ~s = __Stack0,\n">>, 
                          [append(["[", tl(A), " | __Stack]"])])
           end,
    St = St40#yecc{line = St40#yecc.line + NLines},
    fwrite(St, <<" [begin\n~ts\n  end | ~s].\n\n">>,
           [pp_tokens(Tokens), Stack]).

output_nowarn(St, Function, Suffix, Arity) ->
    S = case Suffix of '' -> ""; _ -> integer_to_list(Suffix) end,
    St1 = fwrite(St, <<"-dialyzer({nowarn_function, ~w~s/~w}).\n">>,
                 [Function, S, Arity]),
    fwrite(St1, <<"-compile({nowarn_unused_function,  ~w~s/~w}).\n">>,
                 [Function, S, Arity]).

inlined_function_name(St, State, Terminal) ->
    End = case Terminal of
              "Cat" -> [];
              _ -> [safe_atom_chars(St, Terminal)]
          end,
    list_to_atom(concat([yeccpars2_, State, '_'] ++ End)).

-compile({nowarn_unused_function,function_name/3}).
function_name(St, Name, Suf) ->
    list_to_atom(concat([Name, '_', safe_atom_chars(St, Suf)])).

safe_atom_chars(St, Atom) when is_atom(Atom) ->
    case St of
        #yecc{encoding = latin1} ->
            io_lib:write_atom_as_latin1(Atom);
        #yecc{} ->
            atom_to_list(Atom)
    end;
safe_atom_chars(_St, Atomic) ->
    io_lib:write(Atomic).

rule(RulePointer, St) ->
    #rule{n = N, location = Location, symbols = Symbols} =
        maps:get(RulePointer, St#yecc.rule_pointer2rule),
    {Symbols, Location, N}.

get_rule(RuleNmbr, St) ->
    maps:get(RuleNmbr, St#yecc.rule_pointer2rule).

tokens(RuleNmbr, St) ->
    Rule = maps:get(RuleNmbr, St#yecc.rule_pointer2rule),
    Rule#rule.tokens.

goto(From, Symbol, St) ->
    case ets:lookup(St#yecc.goto_tab, {From, Symbol}) of
        [{_, To}] ->
            To;
        [] ->
            erlang:error({error_in_goto_table, From, Symbol})
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliaries:

-ifdef(SYMBOLS_AS_CODES).

%%% Bit mask operations.

-compile({inline,[set_empty/0]}).
set_empty() ->
    0.

set_add(I, BM) ->
    (1 bsl I) bor BM.

-compile({inline,[set_member/2]}).
set_member(I, BM) ->
    ((1 bsl I) band BM) =/= 0.

%% Assumes I is a member...
-compile({inline,[set_delete/2]}).
set_delete(I, BM) ->
    (1 bsl I) bxor BM.

-compile({inline,[set_union/2]}).
set_union(BM1, BM2) ->
    BM1 bor BM2.

-compile({inline,[set_is_subset/2]}).
set_is_subset(BM1, BM2) ->
    (BM1 band BM2) =:= BM1.

empty_member(BM) ->
    set_member(0, BM).

empty_delete(BM) ->
    set_delete(0, BM).

code_symbols(Ss, SymbolTable) ->
    map(fun(S) -> ets:lookup_element(SymbolTable, S, 2) end, Ss).

decode_symbol(C, InvSymbolTable) ->
    ets:lookup_element(InvSymbolTable, C, 1).

code_terminal(T, SymbolTab) ->
    set_add(ets:lookup_element(SymbolTab, T, 2), 0).

decode_terminals(BM, InvSymbolTab) ->
    case get(BM) of
        undefined -> 
            Symbols = decode_terminals(BM, 0, InvSymbolTab),
            put(BM, Symbols),
            Symbols;
        Symbols -> 
            Symbols
    end.

decode_terminals(0, _I, _InvSymbolTab) ->
    [];
decode_terminals(BM, I, InvSymbolTab) ->
    case set_member(I, BM) of
        true ->
            [ets:lookup_element(InvSymbolTab, I, 1)
             | decode_terminals(set_delete(I, BM), I+1, InvSymbolTab)];
        false ->
            decode_terminals(BM, I+1, InvSymbolTab)
    end.

set_add_terminal({_Symbol, TerminalNum}, BM) ->
    set_add(TerminalNum, BM).

-compile({inline,[is_terminal/2]}).
is_terminal(_Tab, SymbolCode) ->
    SymbolCode >= 0.

left_corner_symbol_table(St) ->
    St#yecc.inv_symbol_tab.

-else.

set_empty() ->
    [].

set_add(Symbol, L) ->
    ordsets:union([Symbol], L).

set_union(Es1, Es2) ->
    ordsets:union(Es1, Es2).

set_is_subset(Es1, Es2) ->
    ordsets:is_subset(Es1, Es2).

code_symbols(Ss, _SymbolTab) ->
    Ss.

decode_symbol(S, _InvSymbolTab) ->
    S.

code_terminal(T, _SymbolTab) ->
    [T].

decode_terminals(Ts, _InvSymbolTab) ->
    Ts.

empty_member(['$empty' | _]) ->
    true;
empty_member(_) ->
    false.

empty_delete(['$empty' | Terminals]) ->
    Terminals.

set_add_terminal({Symbol, _TerminalNum}, L) ->
    set_add(Symbol, L).

is_terminal(Tab, SymbolName) ->
   ets:lookup_element(Tab, SymbolName, 2) >= 0.

left_corner_symbol_table(St) ->
    St#yecc.symbol_tab.

-endif. % SYMBOLS_AS_CODES

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

format_symbols([Sym | Syms]) ->
    concat([format_symbol(Sym) | format_symbols1(Syms)]).

format_symbols1([]) ->
    [];
format_symbols1([H | T]) ->
    [" ", format_symbol(H) | format_symbols1(T)].

include(St, File, Outport) ->
    case file:open(File, [read]) of
        {error, Reason} ->
            throw(add_error(File, none, {file_error, Reason}, St));
        {ok, Inport} ->
            _ = epp:set_encoding(Inport),
            Line = io:get_line(Inport, ''),
            try include1(Line, Inport, Outport, File, 1, St) - 1
            after ok = file:close(Inport)
            end
    end.

include1(eof, _, _, _File, L, _St) ->
    L;
include1({error, _}=_Error, _Inport, _Outport, File, L, St) ->
    throw(add_error(File, erl_anno:new(L), cannot_parse, St));
include1(Line, Inport, Outport, File, L, St) ->
    Incr = case member($\n, Line) of
               true -> 1;
               false -> 0
           end,
    io:put_chars(Outport, Line),
    include1(io:get_line(Inport, ''), Inport, Outport, File, L + Incr, St).

includefile_version([]) ->
    {1,4};
includefile_version(Includefile) ->
    case epp:open(Includefile, []) of
        {ok, Epp} ->
            try
                parse_file(Epp)
            after
                epp:close(Epp)
            end;
        {error, _Error} ->
            {1,1}
    end.

parse_file(Epp) ->
    case epp:parse_erl_form(Epp) of
        {ok, {function,_Anno,yeccpars1,7,_Clauses}} ->
            {1,4};
        {eof,_Location} ->
            {1,1};
        _Form ->
            parse_file(Epp)
    end.

%% Keeps the line breaks and the column numbers of the original code.
pp_tokens(Tokens) ->
    C = first_column(Tokens),
    Indent = lists:duplicate(C - 1, $\s),
    Text = lists:append([erl_anno:text(anno(T)) || T <- Tokens]),
    [Indent, Text].
    
set_encoding(#yecc{encoding = none}, Port) ->
    ok = io:setopts(Port, [{encoding, epp:default_encoding()}]);
set_encoding(#yecc{encoding = E}, Port) ->
    ok = io:setopts(Port, [{encoding, E}]).

output_encoding_comment(#yecc{encoding = none}=St) ->
    St;
output_encoding_comment(#yecc{encoding = Encoding}=St) ->
    fwrite(St, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]).

output_file_directive(St, Filename, Line) when St#yecc.file_attrs ->
    fwrite(St, <<"-file(~ts, ~w).\n">>,
           [format_filename(Filename, St), Line]);
output_file_directive(St, _Filename, _Line) ->
    St.

first_column(Tokens) ->
    case erl_anno:column(anno(hd(Tokens))) of
        undefined ->
            1;
        Column ->
            Column
    end.

first_line(Tokens) ->
    line(anno(hd(Tokens))).

last_line(Tokens) ->
    line(anno(lists:last(Tokens))).

line(Anno) ->
    erl_anno:line(Anno).

location(none) -> none;
location(Anno) ->
    erl_anno:location(Anno).

anno(Token) ->
    element(2, Token).

%% Keep track of the current line in the generated file.
fwrite(#yecc{outport = Outport, line = Line}=St, Format, Args) ->
    NLines = count_nl(Format),
    io:fwrite(Outport, Format, Args),
    St#yecc{line = Line + NLines}.

%% Assumes \n is used, and never ~n.
count_nl(<<$\n,Rest/binary>>) ->
    1 + count_nl(Rest);
count_nl(<<_,Rest/binary>>) ->
    count_nl(Rest);
count_nl(<<>>) ->
    0.

nl(#yecc{outport = Outport, line = Line}=St) ->
    io:nl(Outport),
    St#yecc{line = Line + 1}.

format_filename(Filename0, St) ->
    Deterministic = proplists:get_bool(deterministic, St#yecc.options),
    Filename =
      case Deterministic of
        true -> filename:basename(filename:flatten(Filename0));
        false -> filename:flatten(Filename0)
      end,
    case lists:keyfind(encoding, 1, io:getopts(St#yecc.outport)) of
        {encoding, unicode} -> io_lib:write_string(Filename);
        _ ->                   io_lib:write_string_as_latin1(Filename)
    end.

format_assoc(left) ->
    "Left";
format_assoc(right) ->
    "Right";
format_assoc(unary) ->
    "Unary";
format_assoc(nonassoc) ->
    "Nonassoc".

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

line_of_location(Line) when is_integer(Line) ->
    Line;
line_of_location({Line, Column}) when is_integer(Line), is_integer(Column) ->
    Line.

inverse(L) ->
    sort([{A,B} || {B,A} <- L]).

family(L) ->
    sofs:to_external(sofs:relation_to_family(sofs:relation(L))).

seq1(To) when To < 1 ->
    [];
seq1(To) ->
    lists:seq(1, To).

count(From, L) ->
    lists:zip(L, lists:seq(From, length(L)-1+From)).

family_with_domain(L, DL) ->
    sofs:to_external(sofs_family_with_domain(sofs:relation(L), sofs:set(DL))).

sofs_family_with_domain(R0, D) ->
    R = sofs:restriction(R0, D),
    F = sofs:relation_to_family(R),
    FD = sofs:constant_function(D, sofs:from_term([])),
    sofs:family_union(F, FD).