#!perl -w

# mkmnglex.pl - Builds (f)lex compilable files from the [PJM]NG EBNF grammar
# Author: Cosmin Truta, Jan 2001


@ARGV > 0 || die "Usage: mkmnglex.pl <file1.ebnf> ...\n";


# Write the heading of the output file
print "%{\n#define YY_MAIN 1\n%}\n\n";
print "%option noyywrap\n\n\n";


# Initialize the variables
%map_symbols = ();
$has_png = 0;
$has_jng = 0;
$has_mng = 0;
$had_empty_line = 0;
$buf_rule = "";


# Do the EBNF -> flex conversion
# ** The input files must start and/or end with an empty line!
while ($line = <>)
{
  chomp $line;
  $line =~ s/#.*$//;  # strip the comments if present
  if ($line =~ /^\s*$/)  # a new production rule might follow
  {
    if (!$had_empty_line)
    {
      write_rule($buf_rule);
      $buf_rule = "";
    }
    $had_empty_line = 1;
    next;
  }

  # Translate the line into (f)lex format
  $line =~ s/(\W)([pjm]ng_\w+)/$1\{$2\}/g;
  $line =~ s/\s+//g;  # remove all blanks
  $line =~ s/::=/\t/;

  # Update the flags
  $had_empty_line = 0;
  $has_png = 1 if ($line =~ /^png_datastream\s/);
  $has_jng = 1 if ($line =~ /^jng_datastream\s/);
  $has_mng = 1 if ($line =~ /^mng_datastream\s/);

  $buf_rule .= $line;
}

# Write the remaining buffer
write_rule($buf_rule);


# Write the tail of the output file
print "\n\n%%\n\n\n";
print "{png_datastream}\tprintf(\"PNG datastream encountered\\n\"); return 1;\n\n"
  if ($has_png);
print "{jng_datastream}\tprintf(\"JNG datastream encountered\\n\"); return 1;\n\n"
  if ($has_jng);
print "{mng_datastream}\tprintf(\"MNG datastream encountered\\n\"); return 1;\n\n"
  if ($has_mng);
#print "(....)*LOOP([^E]...|.[^N]..|..[^D].|...[^L])*LOOP\tprintf(\"Sorry, embedded loops cannot be handled\\n\"); return 0;\n\n"
#  if ($has_mng);
print ".*\tprintf(\"Unrecognized character(s) encountered: '%s'\\n\", yytext); return 0;\n\n";


# Simple error check
$has_png || $has_jng || $has_mng ||
  die "** Error: no PNG/JNG/MNG grammar found.\n";


###############################################################################

# Write the output line to the standard output
sub write_rule
{
  $output_line = shift;
  if ($output_line ne "")
  {
    $output_line =~ /^(\S+)/ ||
      die "** Error: something wrong in the output \"$output_line\"\n";
    $non_terminal = $1;
    if (!defined $map_symbols{$non_terminal})
    {
      $map_symbols{$non_terminal} = $output_line;

      if ($output_line =~ /{$non_terminal}/)
      {
        recurse_rule($non_terminal, $output_line, 12);
      }
      else
      {
        print $output_line, "\n\n";
      }
    }
    else
    {
      die "** Error: non-identical definitions for \"$non_terminal\"\n"
        if ($map_symbols{$non_terminal} ne $output_line);
    }
  }
}


###############################################################################

# Recurse the a non-terminal symbol a finite number of times
sub recurse_rule
{
  $rec_symbol = shift;
  $rec_line   = shift;
  $rec_max    = shift;

  $rec_max > 1 || die "** Error: invalid max. recursion level $rec_max\n";

  $rec_crt = $rec_max - 1;
  $rec_old_symbol = $rec_symbol;
  $rec_crt_symbol = $rec_symbol . "_" . $rec_crt;
  do
  {
    $rec_line =~ s/^\S+/$rec_old_symbol/;
    $rec_line =~ s/{$rec_symbol.*}/{$rec_crt_symbol}/;
    print $rec_line, "\n";

    $rec_old_symbol = $rec_crt_symbol;
    $rec_crt--;
    $rec_crt_symbol = $rec_symbol . "_" . $rec_crt;
  } while ($rec_crt >= 1);

  $rec_line =~ s/^\S+/$rec_old_symbol/;
  $rec_line =~ s/\|{$rec_symbol.*}//;
  print $rec_line, "\n";

  print "\n";
}