src/parser/fact_parser.pl

   1 #!/usr/bin/perl
   2
   3 # This file is part of NIT ( http://www.nitlanguage.org ).
   4 #
   5 # Licensed under the Apache License, Version 2.0 (the "License");
   6 # you may not use this file except in compliance with the License.
   7 # You may obtain a copy of the License at
   8 #
   9 #     http://www.apache.org/licenses/LICENSE-2.0
  10 #
  11 # Unless required by applicable law or agreed to in writing, software
  12 # distributed under the License is distributed on an "AS IS" BASIS,
  13 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  14 # See the License for the specific language governing permissions and
  15 # limitations under the License.
  16
  17 # fact_parser, a Sablecc postprocessor.
  18 #
  19 # Factorize comon actions in a generated sablecc parser file
  20 # Synopsys: fact_parser < infile > outfile
  21
  22 use warnings;
  23
  24 %actions = (); # body of an action -> id of the first action with this body
  25 %dupl = (); # id of a duplicate action -> id of the first action with this body
  26
  27 @text = (); # Resulting file
  28 $start = 0; # current mode: 0=begin of file; 1=after an action; 2=inside an action
  29 $tot = 0; # original total number of actions
  30 $cpt = 0; # final total number of action
  31 while (<>) {
  32         # Process the body of the action?
  33         if ($start == 2) {
  34                 push @action, $_;
  35                 if (/ new (?!Array)/) { $has_new = 1; }
  36         }
  37
  38         # Start a new action?
  39         if (/private class ReduceAction(\d+)/) {
  40                 $tot++;
  41                 $start = 2;
  42                 $nb = $1; # Identifier of the action
  43                 $head = $_; # The declaration line
  44                 @action = (); # Body of the action
  45                 $has_new = 0; # Is a new something used?
  46         }
  47
  48         # Process the begin of the file?
  49         if ($start == 0) { push @text, $_; }
  50
  51         # End of an action?
  52         if ($start == 2 and /^end/) {
  53                 # Build the action body by filtering useless new
  54                 $action = "";
  55                 foreach $l (@action) {
  56                         if ($has_new or $l !~ / isa (?!Array)/) { $action .= $l; }
  57                 }
  58
  59                 # Is it an original action?
  60                 if (not defined $actions{$action}) {
  61                         # Yes, so register it
  62                         $actions{$action} = $nb;
  63                         push @text, $head, $action;
  64                         $cpt++;
  65                 } else {
  66                         # No, so link the duplicate to the original
  67                         $mainnb = $actions{$action};
  68                         $dupl{$nb} = $mainnb;
  69                 }
  70                 $start = 1;
  71         }
  72 }
  73
  74 # Substitute duplicate actions with the originals in the whole file
  75 foreach (@text) {
  76         if (/ReduceAction(\d+)/ && defined $dupl{$1}) {
  77                 $d = $dupl{$1};
  78                 s/$1/$d/;
  79         }
  80 }
  81
  82 print STDERR "* fact_parser: $tot -> $cpt\n";
  83
  84 print @text;