#!/usr/bin/perl
# src/interfaces/ecpg/preproc/parse.pl
# parser generator for ecpg
#
# See README.parser for some explanation of what this does.
#
# Command-line options:
#   --srcdir: where to find ecpg-provided input files (default ".")
#   --parser: the backend gram.y file to read (required, no default)
#   --output: where to write preproc.y (required, no default)
#
# Copyright (c) 2007-2025, PostgreSQL Global Development Group
#
# Written by Mike Aubury <mike.aubury@aubit.com>
#            Michael Meskes <meskes@postgresql.org>
#            Andy Colson <andy@squeakycode.net>
#
# Placed under the same license as PostgreSQL.
#

use strict;
use warnings FATAL => 'all';
use Getopt::Long;

my $srcdir = '.';
my $outfile = '';
my $parser = '';

GetOptions(
 'srcdir=s' => \$srcdir,
 'output=s' => \$outfile,
 'parser=s' => \$parser,) or die "wrong arguments";


# These hash tables define additional transformations to apply to
# grammar rules.  For bug-detection purposes, we count usages of
# each hash table entry in a second hash table, and verify that
# all the entries get used.

# Substitutions to apply to tokens whenever they are seen in a rule.
my %replace_token = (
 'BCONST' => 'ecpg_bconst',
 'FCONST' => 'ecpg_fconst',
 'Sconst' => 'ecpg_sconst',
 'XCONST' => 'ecpg_xconst',
 'IDENT' => 'ecpg_ident',
 'PARAM' => 'ecpg_param',);

my %replace_token_used;

# This hash can provide a result type to override "void" for nonterminals
# that need that, or it can specify 'ignore' to cause us to skip the rule
# for that nonterminal.  (In either case, ecpg.trailer had better provide
# a substitute rule, since the default won't do.)
my %replace_types = (
 'PrepareStmt' => '<prep>',
 'ExecuteStmt' => '<exec>',
 'opt_array_bounds' => '<index>',

 # "ignore" means: do not create type and rules for this nonterminal
 'parse_toplevel' => 'ignore',
 'stmtmulti' => 'ignore',
 'CreateAsStmt' => 'ignore',
 'DeallocateStmt' => 'ignore',
 'ColId' => 'ignore',
 'type_function_name' => 'ignore',
 'ColLabel' => 'ignore',
 'Sconst' => 'ignore',
 'opt_distinct_clause' => 'ignore',
 'PLpgSQL_Expr' => 'ignore',
 'PLAssignStmt' => 'ignore',
 'plassign_target' => 'ignore',
 'plassign_equals' => 'ignore',);

my %replace_types_used;

# This hash provides an "ignore" option or substitute expansion for any
# rule or rule alternative.  The hash key is the same "tokenlist" tag
# used for lookup in ecpg.addons.
my %replace_line = (
 # These entries excise certain keywords from the core keyword lists.
 # Be sure to account for these in ColLabel and related productions.
 'unreserved_keyword CONNECTION' => 'ignore',
 'unreserved_keyword CURRENT_P' => 'ignore',
 'unreserved_keyword DAY_P' => 'ignore',
 'unreserved_keyword HOUR_P' => 'ignore',
 'unreserved_keyword INPUT_P' => 'ignore',
 'unreserved_keyword MINUTE_P' => 'ignore',
 'unreserved_keyword MONTH_P' => 'ignore',
 'unreserved_keyword SECOND_P' => 'ignore',
 'unreserved_keyword YEAR_P' => 'ignore',
 'col_name_keyword CHAR_P' => 'ignore',
 'col_name_keyword INT_P' => 'ignore',
 'col_name_keyword VALUES' => 'ignore',
 'reserved_keyword TO' => 'ignore',
 'reserved_keyword UNION' => 'ignore',

 # some other production rules have to be ignored or replaced
 'fetch_args FORWARD opt_from_in cursor_name' => 'ignore',
 'fetch_args BACKWARD opt_from_in cursor_name' => 'ignore',
 "opt_array_bounds opt_array_bounds '[' Iconst ']'" => 'ignore',
 'VariableShowStmt SHOW var_name' => 'SHOW var_name ecpg_into',
 'VariableShowStmt SHOW TIME ZONE' => 'SHOW TIME ZONE ecpg_into',
 'VariableShowStmt SHOW TRANSACTION ISOLATION LEVEL' =>
   'SHOW TRANSACTION ISOLATION LEVEL ecpg_into',
 'VariableShowStmt SHOW SESSION AUTHORIZATION' =>
   'SHOW SESSION AUTHORIZATION ecpg_into',
 'returning_clause RETURNING returning_with_clause target_list' =>
   'RETURNING returning_with_clause target_list opt_ecpg_into',
 'ExecuteStmt EXECUTE name execute_param_clause' =>
   'EXECUTE prepared_name execute_param_clause execute_rest',
 'ExecuteStmt CREATE OptTemp TABLE create_as_target AS EXECUTE name execute_param_clause opt_with_data'
   => 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause opt_with_data execute_rest',
 'ExecuteStmt CREATE OptTemp TABLE IF_P NOT EXISTS create_as_target AS EXECUTE name execute_param_clause opt_with_data'
   => 'CREATE OptTemp TABLE IF_P NOT EXISTS create_as_target AS EXECUTE prepared_name execute_param_clause opt_with_data execute_rest',
 'PrepareStmt PREPARE name prep_type_clause AS PreparableStmt' =>
   'PREPARE prepared_name prep_type_clause AS PreparableStmt',
 'var_name ColId' => 'ECPGColId');

my %replace_line_used;


# Declare assorted state variables.

# yaccmode counts the '%%' separator lines we have seen, so that we can
# distinguish prologue, rules, and epilogue sections of gram.y.
my $yaccmode = 0;
# in /* ... */ comment?
my $comment = 0;
# in { ... } braced text?
my $brace_indent = 0;
# within a rule (production)?
my $in_rule = 0;
# count of alternatives processed within the current rule.
my $alt_count = 0;
# copymode = 1 when we want to emit the current rule to preproc.y.
# If it's 0, we have decided to ignore the current rule, and should
# skip all output until we get to the ending semicolon.
my $copymode = 0;
# tokenmode = 1 indicates we are processing %token and following declarations.
my $tokenmode = 0;
# stmt_mode = 1 indicates that we are processing the 'stmt:' rule.
my $stmt_mode = 0;
# Hacky state for emitting feature-not-supported warnings.
my $has_feature_not_supported = 0;
my $has_if_command = 0;

# %addons holds the rules loaded from ecpg.addons.
my %addons;

# %buff holds various named "buffers", which are just strings that accumulate
# the output destined for different sections of the preproc.y file.  This
# allows us to process the input in one pass even though the resulting output
# needs to appear in various places.  See dump_buffer calls below for the
# set of buffer names and the order in which they'll be dumped.
my %buff;

# %tokens contains an entry for every name we have discovered to be a token.
my %tokens;

# $non_term_id is the name of the nonterminal that is the target of the
# current rule.
my $non_term_id;

# $line holds the reconstructed rule text (that is, RHS token list) that
# we plan to emit for the current rule.
my $line = '';

# count of tokens included in $line.
my $line_count = 0;


# Open parser / output file early, to raise errors early.
open(my $parserfh, '<', $parser) or die "could not open parser file $parser";
open(my $outfh, '>', $outfile) or die "could not open output file $outfile";

# Read the various ecpg-supplied input files.
# ecpg.addons is loaded into the %addons hash, while the other files
# are just copied into buffers for verbatim output later.
preload_addons();
include_file('header', 'ecpg.header');
include_file('tokens', 'ecpg.tokens');
include_file('ecpgtype', 'ecpg.type');
include_file('trailer', 'ecpg.trailer');

# Read gram.y, and do the bulk of the processing.
main();

# Emit data from the various buffers we filled.
dump_buffer('header');
dump_buffer('tokens');
dump_buffer('types');
dump_buffer('ecpgtype');
dump_buffer('orig_tokens');
print $outfh '%%', "\n";
print $outfh 'prog: statements;', "\n";
dump_buffer('rules');
dump_buffer('trailer');

close($parserfh);

# Cross-check that we don't have dead or ambiguous addon rules.
foreach (keys %addons)
{
 die "addon rule $_ was never used\n" if $addons{$_}{used} == 0;
 die "addon rule $_ was matched multiple times\n" if $addons{$_}{used} > 1;
}

# Likewise cross-check that entries in our internal hash tables match something.
foreach (keys %replace_token)
{
 die "replace_token entry $_ was never used\n"
   if !defined($replace_token_used{$_});
 # multiple use of a replace_token entry is fine
}

foreach (keys %replace_types)
{
 die "replace_types entry $_ was never used\n"
   if !defined($replace_types_used{$_});
 die "replace_types entry $_ was matched multiple times\n"
   if $replace_types_used{$_} > 1;
}

foreach (keys %replace_line)
{
 die "replace_line entry $_ was never used\n"
   if !defined($replace_line_used{$_});
 die "replace_line entry $_ was matched multiple times\n"
   if $replace_line_used{$_} > 1;
}


# Read the backend grammar.
sub main
{
  line: while (<$parserfh>)
 {
  chomp;

  if (/^%%/)
  {
   # New file section, so advance yaccmode.
   $yaccmode++;
   # We are no longer examining %token and related commands.
   $tokenmode = 0;
   # Shouldn't be anything else on the line.
   next line;
  }

  # Hacky check for rules that throw FEATURE_NOT_SUPPORTED
  # (do this before $_ has a chance to get clobbered)
  if ($yaccmode == 1)
  {
   $has_feature_not_supported = 1 if /ERRCODE_FEATURE_NOT_SUPPORTED/;
   $has_if_command = 1 if /^\s*if/;
  }

  # Make sure any braces are split into separate fields
  s/{/ { /g;
  s/}/ } /g;

  # Likewise for comment start/end markers
  s|\/\*| /* |g;
  s|\*\/| */ |g;

  # Now split the line into individual fields
  my @arr = split(' ');

  # Ignore empty lines
  if (!@arr)
  {
   next line;
  }

  # Once we have seen %token in the prologue, we assume all that follows
  # up to the '%%' separator is %token and associativity declarations.
  # Collect and process that as necessary.
  if ($arr[0] eq '%token' && $yaccmode == 0)
  {
   $tokenmode = 1;
  }

  if ($tokenmode == 1)
  {
   # Collect everything of interest on this line into $str.
   my $str = '';
   for my $a (@arr)
   {
    # Skip comments.
    if ($a eq '/*')
    {
     $comment++;
     next;
    }
    if ($a eq '*/')
    {
     $comment--;
     next;
    }
    if ($comment)
    {
     next;
    }

    # If it's "<something>", it's a type in a %token declaration,
    # which we should just drop so that the tokens have void type.
    if (substr($a, 0, 1) eq '<')
    {
     next;
    }

    # Remember that this is a token.  This will also make entries
    # for "%token" and the associativity keywords such as "%left",
    # which should be harmless so it's not worth the trouble to
    # avoid it.  If a token appears both in %token and in an
    # associativity declaration, we'll redundantly re-set its
    # entry, which is also OK.
    $tokens{$a} = 1;

    # Accumulate the line in $str.
    $str = $str . ' ' . $a;

    # Give our token CSTRING the same precedence as IDENT.
    if ($a eq 'IDENT' && $arr[0] eq '%nonassoc')
    {
     $str = $str . " CSTRING";
    }
   }
   # Save the lightly-processed line in orig_tokens.
   add_to_buffer('orig_tokens', $str);
   next line;
  }

  # The rest is only appropriate if we're in the rules section of gram.y
  if ($yaccmode != 1)
  {
   next line;
  }

  # Go through each word of the rule in turn
  for (
   my $fieldIndexer = 0;
   $fieldIndexer < scalar(@arr);
   $fieldIndexer++)
  {
   # Detect and ignore comments and braced action text
   if ($arr[$fieldIndexer] eq '*/' && $comment)
   {
    $comment = 0;
    next;
   }
   elsif ($comment)
   {
    next;
   }
   elsif ($arr[$fieldIndexer] eq '/*')
   {
    # start of a possibly-multiline comment
    $comment = 1;
    next;
   }
   elsif ($arr[$fieldIndexer] eq '}')
   {
    $brace_indent--;
    next;
   }
   elsif ($arr[$fieldIndexer] eq '{')
   {
    $brace_indent++;
    next;
   }
   if ($brace_indent > 0)
   {
    next;
   }

   # OK, it's not a comment or part of an action.
   # Check for ';' ending the current rule, or '|' ending the
   # current alternative.
   if ($arr[$fieldIndexer] eq ';')
   {
    if ($copymode)
    {
     # Print the accumulated rule.
     emit_rule();
     add_to_buffer('rules', ";\n\n");
    }
    else
    {
     # End of an ignored rule; revert to copymode = 1.
     $copymode = 1;
    }

    # Reset for the next rule.
    $line = '';
    $line_count = 0;
    $in_rule = 0;
    $alt_count = 0;
    $has_feature_not_supported = 0;
    $has_if_command = 0;
    next;
   }

   if ($arr[$fieldIndexer] eq '|')
   {
    if ($copymode)
    {
     # Print the accumulated alternative.
     # Increment $alt_count for each non-ignored alternative.
     $alt_count += emit_rule();
    }

    # Reset for the next alternative.
    # Start the next line with '|' if we've printed at least one
    # alternative.
    if ($alt_count > 1)
    {
     $line = '| ';
    }
    else
    {
     $line = '';
    }
    $line_count = 0;
    $has_feature_not_supported = 0;
    $has_if_command = 0;
    next;
   }

   # Apply replace_token substitution if we have one.
   if (exists $replace_token{ $arr[$fieldIndexer] })
   {
    $replace_token_used{ $arr[$fieldIndexer] }++;
    $arr[$fieldIndexer] = $replace_token{ $arr[$fieldIndexer] };
   }

   # Are we looking at a declaration of a non-terminal?
   # We detect that by seeing ':' on the end of the token or
   # as the next token.
   if (($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:$/)
    || (   $fieldIndexer + 1 < scalar(@arr)
     && $arr[ $fieldIndexer + 1 ] eq ':'))
   {
    # Extract the non-terminal, sans : if any
    $non_term_id = $arr[$fieldIndexer];
    $non_term_id =~ tr/://d;

    # Consume the ':' if it's separate
    if (!($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:$/))
    {
     $fieldIndexer++;
    }

    # Check for %replace_types entry indicating to ignore it.
    if (defined $replace_types{$non_term_id}
     && $replace_types{$non_term_id} eq 'ignore')
    {
     # We'll ignore this nonterminal and rule altogether.
     $replace_types_used{$non_term_id}++;
     $copymode = 0;
     next line;
    }

    # OK, we want this rule.
    $copymode = 1;

    # Set special mode for the "stmt:" rule.
    if ($non_term_id eq 'stmt')
    {
     $stmt_mode = 1;
    }
    else
    {
     $stmt_mode = 0;
    }

    # Emit appropriate %type declaration for this nonterminal,
    # if it has a type; otherwise omit that.
    if (defined $replace_types{$non_term_id})
    {
     my $tstr =
      '%type '
       . $replace_types{$non_term_id} . ' '
       . $non_term_id;
     add_to_buffer('types', $tstr);
     $replace_types_used{$non_term_id}++;
    }

    # Emit the target part of the rule.
    # Note: the leading space is just to match
    # the rather weird pre-v18 output logic.
    my $tstr = ' ' . $non_term_id . ':';
    add_to_buffer('rules', $tstr);

    # Prepare for reading the tokens of the rule.
    $line = '';
    $line_count = 0;
    die "unterminated rule at grammar line $.\n"
      if $in_rule;
    $in_rule = 1;
    $alt_count = 1;
    next;
   }
   elsif ($copymode)
   {
    # Not a nonterminal declaration, so just add it to $line.
    $line = $line . ' ' . $arr[$fieldIndexer];
    $line_count++;
   }
  }
 }
 die "unterminated rule at end of grammar\n"
   if $in_rule;
 return;
}


# append a file onto a buffer.
# Arguments:  buffer_name, filename (without path)
sub include_file
{
 my ($buffer, $filename) = @_;
 my $full = "$srcdir/$filename";
 open(my $fh, '<', $full) or die;
 while (<$fh>)
 {
  chomp;
  add_to_buffer($buffer, $_);
 }
 close($fh);
 return;
}

# Emit the semantic action for the current rule.
# This function mainly accounts for any modifications specified
# by an ecpg.addons entry.
sub emit_rule_action
{
 my ($tag) = @_;

 # See if we have an addons entry; if not, just emit default action
 my $rec = $addons{$tag};
 if (!$rec)
 {
  emit_default_action(0);
  return;
 }

 # Track addons entry usage for later cross-check
 $rec->{used}++;

 my $rectype = $rec->{type};
 if ($rectype eq 'rule')
 {
  # Emit default action and then the code block.
  emit_default_action(0);
 }
 elsif ($rectype eq 'addon')
 {
  # Emit the code block wrapped in the same braces as the default action.
  add_to_buffer('rules', ' { ');
 }

 # Emit the addons entry's code block.
 # We have an array to add to the buffer, we'll add it directly instead of
 # calling add_to_buffer, which does not know about arrays.
 push(@{ $buff{'rules'} }, @{ $rec->{lines} });

 if ($rectype eq 'addon')
 {
  emit_default_action(1);
 }
 return;
}

# Add the given line to the specified buffer.
#   Pass:  buffer_name, string_to_append
# Note we add a newline automatically.
sub add_to_buffer
{
 push(@{ $buff{ $_[0] } }, "$_[1]\n");
 return;
}

# Dump the specified buffer to the output file.
sub dump_buffer
{
 my ($buffer) = @_;
 # Label the output for debugging purposes.
 print $outfh '/* ', $buffer, ' */', "\n";
 my $ref = $buff{$buffer};
 print $outfh @$ref;
 return;
}

# Emit the default action (usually token concatenation) for the current rule.
#   Pass: brace_printed boolean
# brace_printed should be true if caller already printed action's open brace.
sub emit_default_action
{
 my ($brace_printed) = @_;

 if ($stmt_mode == 0)
 {
  # Normal rule
  if ($has_feature_not_supported and not $has_if_command)
  {
   # The backend unconditionally reports
   # FEATURE_NOT_SUPPORTED in this rule, so let's emit
   # a warning on the ecpg side.
   if (!$brace_printed)
   {
    add_to_buffer('rules', ' { ');
    $brace_printed = 1;
   }
   add_to_buffer('rules',
    'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");'
   );
  }

  add_to_buffer('rules', '}') if ($brace_printed);
 }
 else
 {
  # We're in the "stmt:" rule, where we need to output special actions.
  # This code assumes that no ecpg.addons entry applies.
  if ($line_count)
  {
   # Any regular kind of statement calls output_statement
   add_to_buffer('rules',
    ' { output_statement(@1, 0, ECPGst_normal); }');
  }
  else
  {
   # The empty production for stmt: do nothing
  }
 }
 return;
}

# Print the accumulated rule text (in $line) and the appropriate action.
# Ordinarily return 1.  However, if the rule matches an "ignore"
# entry in %replace_line, then do nothing and return 0.
sub emit_rule
{
 # compute tag to be used as lookup key in %replace_line and %addons
 my $tag = $non_term_id . ' ' . $line;
 $tag =~ tr/|//d;
 $tag = join(' ', split(/\s+/, $tag));

 # apply replace_line substitution if any
 my $rep = $replace_line{$tag};
 if (defined $rep)
 {
  $replace_line_used{$tag}++;

  if ($rep eq 'ignore')
  {
   return 0;
  }

  # non-ignore entries replace the line, but we'd better keep any '|';
  # we don't bother to update $line_count here.
  if (index($line, '|') != -1)
  {
   $line = '| ' . $rep;
  }
  else
  {
   $line = $rep;
  }

  # recompute tag for use in emit_rule_action
  $tag = $non_term_id . ' ' . $line;
  $tag =~ tr/|//d;
  $tag = join(' ', split(/\s+/, $tag));
 }

 # Emit $line, then print the appropriate action.
 add_to_buffer('rules', $line);
 emit_rule_action($tag);
 return 1;
}

=top
 load ecpg.addons into %addons hash.  The result is something like
 %addons = {
  'stmt ClosePortalStmt' => { 'type' => 'block', 'lines' => [ "{", "if (INFORMIX_MODE)" ..., "}" ], 'used' => 0 },
  'stmt ViewStmt' => { 'type' => 'rule', 'lines' => [ "| ECPGAllocateDescr", ... ], 'used' => 0 }
 }

=cut

sub preload_addons
{
 my $filename = $srcdir . "/ecpg.addons";
 open(my $fh, '<', $filename) or die;

 # There may be multiple "ECPG:" lines and then multiple lines of code.
 # The block of code needs to be added to each of the consecutively-
 # preceding "ECPG:" records.
 my (@needsRules, @code);

 # there may be comments before the first "ECPG:" line, skip them
 my $skip = 1;
 while (<$fh>)
 {
  if (/^ECPG:\s+(\w+)\s+(.*)$/)
  {
   # Found an "ECPG:" line, so we're done skipping the header
   $skip = 0;
   my $type = $1;
   my $target = $2;
   # Normalize target so there's exactly one space between tokens
   $target = join(' ', split(/\s+/, $target));
   # Validate record type and target
   die "invalid record type $type in addon rule for $target\n"
     unless ($type eq 'block'
    or $type eq 'addon'
    or $type eq 'rule');
   die "duplicate addon rule for $target\n"
     if (exists $addons{$target});
   # If we had some preceding code lines, attach them to all
   # as-yet-unfinished records.
   if (@code)
   {
    for my $x (@needsRules)
    {
     push(@{ $x->{lines} }, @code);
    }
    @code = ();
    @needsRules = ();
   }
   my $record = {};
   $record->{type} = $type;
   $record->{lines} = [];
   $record->{used} = 0;
   $addons{$target} = $record;
   push(@needsRules, $record);
  }
  elsif (/^ECPG:/)
  {
   # Complain if preceding regex failed to match
   die "incorrect syntax in ECPG line: $_\n";
  }
  else
  {
   # Non-ECPG line: add to @code unless we're still skipping
   next if $skip;
   push(@code, $_);
  }
 }
 close($fh);
 # Deal with final code block
 if (@code)
 {
  for my $x (@needsRules)
  {
   push(@{ $x->{lines} }, @code);
  }
 }
 return;
}