3 # This file is part of NIT ( http://www.nitlanguage.org ).
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
9 # http://www.apache.org/licenses/LICENSE-2.0
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.
17 # fact_parser, a Sablecc postprocessor.
19 # Factorize comon actions in a generated sablecc parser file
20 # Synopsys: fact_parser < infile > outfile
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
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
32 # Process the body of the action?
35 if (/ new (?!Array)/) { $has_new = 1; }
39 if (/private class ReduceAction(\d+)/) {
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?
48 # Process the begin of the file?
49 if ($start == 0) { push
@text, $_; }
52 if ($start == 2 and /^end/) {
53 # Build the action body by filtering useless new
55 foreach $l (@action) {
56 if ($has_new or $l !~ / isa (?!Array)/) { $action .= $l; }
59 # Is it an original action?
60 if (not defined
$actions{$action}) {
62 $actions{$action} = $nb;
63 push
@text, $head, $action;
66 # No, so link the duplicate to the original
67 $mainnb = $actions{$action};
74 # Substitute duplicate actions with the originals in the whole file
76 if (/ReduceAction(\d+)/ && defined
$dupl{$1}) {
82 print STDERR
"* fact_parser: $tot -> $cpt\n";