#!/usr/bin/perl -w

use strict;
use XML::TreeBuilder;

my $tree = XML::TreeBuilder->new;

$tree->parse_file('rec');
# http://www.w3.org/TR/2000/REC-xml-20001006.xml

for ($tree->look_down(_tag => 'prod')) {
    print 'rule ';
    print $_->look_down(_tag => 'lhs')->content_list;
    print " {\n    ";

    my $not = 0;
    my $p = 1;

    my @foo = $_->look_down(_tag => 'rhs');
    for (map { $_->content_list } @foo) {
         if (ref) {
             if (my $t = $_->look_down(_tag => 'nt')) {
                  print '<', $t->content_list, '>';
             }

             $not = 0, print '>' if $not and $p == $not;
             next;
         }
         {
             s/\xC2\xA0/ /g; # Non breaking space
             s/\s+/ /g;
             s/^S//g and do {
                  print '<S>';
                  $not = 0, print '>' if $not and $p == $not;
                  next;
             };
             s/^'([^']*)'// || s/^"([^"]*)"// and do {
                  my $m = $1;
                  if ($m =~ /[\@\$%<>:\\.]/) {
                      $m =~ s/\\/\\\\/g;
                      $m =~ s/'/\\'/g;
                      print "<'$m'>";
                  } else {
                      print $m;
                  }
                  $not = 0, print '>' if $not and $p == $not;
                  redo;
             };
             s/^\[([^]]*)\]// and do {
                  my $m = $1;
                  $m =~ s/#x/\\x/g;
		  my $neg = (($m =~ s/^\^//) ? '-' : '');
                  print "<$neg\[$m]>";
                  $not = 0, print '>' if $not and $p == $not;
                  redo;
             };
             s/^#x([0-9A-Fa-f]+)// and do {
                  print "\\x$1";
                  $not = 0, print '>' if $not and $p == $not;
                  redo;
             };
             s/^-// and do {
                  $not = $p;
                  print '<!after';
                  redo;
             };
             s/^\(// and do {
                  print '[';
                  ++$p;
                  redo;
             };
             s/^\)// and do {
                  print ']';
                  --$p;
                  $not = 0, print '>' if $not and $p == $not;
                  redo;
             };
             s/^[|*+? ]+// and do {
                  (my $x = $&) =~ tr/()/[]/;
                  print $x;
                  redo;
             };
             next if not length;
             print "ERROR: $_\n";
         }
         
    }

    print "\n}\n\n";
}