38.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 my %rules;
   6 my %subrules;
   7 my %final;
   8
   9 while (<>) {
  10         chomp;
  11         last if /^$/;
  12         my ($id, $rest) = /\A(\d+): (.*)\z/;
  13         if ($rest =~ /"(.)"/) {
  14                 $final{$id} = $1;
  15                 next;
  16         }
  17         my @alts;
  18         my @subalts;
  19         for my $seq (split /\|/, $rest) {
  20                 push @alts, [ $seq =~ /(\d+)/g ];
  21                 push @subalts, ($seq =~ /(\d+)/g);
  22         }
  23         $rules{$id} = \@alts;
  24         $subrules{$id} = \@subalts;
  25 }
  26
  27 while (keys %rules) {
  28         RULE:
  29         for my $id (keys %rules) {
  30                 for my $subr (@{ $subrules{$id} }) {
  31                         next RULE if !defined $final{$subr};
  32                 }
  33                 if ($id == 8) {
  34                         $final{$id} = $final{42} . '+';
  35                         delete $rules{$id};
  36                         next RULE;
  37                 }
  38
  39                 if ($id == 11) {
  40                         $final{$id} = '(?:' . join('|',
  41                                 $final{42} . $final{31},
  42                                 $final{42} x 2 . $final{31} x 2,
  43                                 $final{42} x 3 . $final{31} x 3,
  44                                 $final{42} x 4 . $final{31} x 4,
  45                                 $final{42} x 5 . $final{31} x 5,
  46                                 $final{42} x 6 . $final{31} x 6,
  47                                 $final{42} x 7 . $final{31} x 7,
  48                                 $final{42} x 8 . $final{31} x 8,
  49                                 $final{42} x 9 . $final{31} x 9,
  50                                 $final{42} x 10 . $final{31} x 10,
  51                                 $final{42} x 11 . $final{31} x 11,
  52                                 $final{42} x 12 . $final{31} x 12,
  53                                 ) . ')';
  54                         delete $rules{$id};
  55                         next RULE;
  56                 }
  57
  58                 $final{$id} = '(?:(?:' . join(')|(?:', map {
  59                         join('', map { $final{$_} } @$_)
  60                         } @{ $rules{$id} }) .'))';
  61                 print "\$final{$id} = $final{$id}\n";
  62                 delete $rules{$id};
  63         }
  64 }
  65
  66 my $re = '\A'.$final{0}.'\z';
  67
  68 my $count = 0;
  69 while (<>) {
  70         chomp;
  71         $count++ if ($_ =~ /$re/);
  72 }
  73
  74 print "$count matched\n";