src/parser/prescc.pl

   1 #!/usr/bin/perl -w
   2 # This file is part of NIT ( http://www.nitlanguage.org ).
   3 #
   4 # Copyright 2009 Jean Privat <jean@pryen.org>
   5 # Copyright 2009 Jean-Sebastien Gelinas <calestar@gmail.com>
   6 #
   7 # Licensed under the Apache License, Version 2.0 (the "License");
   8 # you may not use this file except in compliance with the License.
   9 # You may obtain a copy of the License at
  10 #
  11 #     http://www.apache.org/licenses/LICENSE-2.0
  12 #
  13 # Unless required by applicable law or agreed to in writing, software
  14 # distributed under the License is distributed on an "AS IS" BASIS,
  15 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  16 # See the License for the specific language governing permissions and
  17 # limitations under the License.
  18
  19 # prescc, a Sablecc preprocessor.
  20 #
  21 # Synopsis
  22 #
  23 #   Extends a sablecc grammar with parametrized productions and other syntactic stuff.
  24 #
  25 # Description
  26 #
  27 #   A production named foo~bar~baz semantically correspond to a production foo with two boolean parameters bar and baz
  28 #   In fact foo is a family of 4 distinct productions: foo, foo_bar, foo_baz and foo_bar_baz
  29 #   In a parametrized production with a parameter ~xxx:
  30 #    * parameters (~xxx) are substituted with _xxx if the parameter is true and removed if the parameter is false
  31 #    * guarded alternatives (!xxx) are disabled if the parameter is true
  32 #
  33 # Limitations
  34 #
  35 #   prescc is badly implemented in perl and is not robust.
  36 #   Users must remember the following:
  37 #    * parametrized productions MUST be terminated with a line containing only a single semicolon (;)
  38 #    * parameters (~) and guards (!) in alternatives MUST correspond to a parameter of the enclosing production
  39 #    * if required, names in transformations MUST contain the full invocation name (with all parameters)
  40 #        foo bar_x~y~z_t baz {-> New p(foo, bar_x~y~z_t.q)}
  41 #    * guards do not understand grammar, they just remove the whole line
  42 #    * The AST MUST start with a line containing only "Abstract Syntax Tree"
  43 #
  44 # Example of the dangling else implementation:
  45 #
  46 #   stmt~withelse =
  47 #                'if' expr 'then' stmt_withelse 'else' stmt~withelse |
  48 #     !withelse  'if' expr 'then' stmt |
  49 #                nop
  50 #                ;
  51
  52 while (<>) {
  53         push @lines, $_;
  54 }
  55 $lines = join "", @lines;
  56
  57 $current = "";
  58 for (@lines) {
  59         if (/^.*{\s*->\s*(\w+)\s*}/) {
  60                 $current = $1;
  61         }
  62         $current = "" if /;/;
  63         next if ($current eq "");
  64         if (s/{\:(\w+)}/{$1}/) {
  65                 $alt = $1;
  66                 @newargs = ();
  67                 while (/((\[(\w*)\])?:)?([\w~]+)(})?/g) {
  68                         $id=defined $3?$3:$4;
  69                         next if ((defined $1) && !(defined $3));
  70                         next if (defined $5);
  71                         $4 =~ /([a-z]+)/;
  72                         $argalt = $1;
  73                         if ($id eq $argalt) {
  74                                 push @newargs, "$id";
  75                         } else {
  76                                 push @newargs, "$id.$argalt";
  77                         }
  78                 }
  79                 chomp;
  80                 $_ .= " {-> New $current.$alt(". join(", ", @newargs) .")}\n";
  81                 s/([^\]])\:(\w+)/$1$2/g;
  82         }
  83 }
  84
  85 # List all the available parameters in the extended grammar
  86 @params = ();
  87 while ($lines =~ /\~([a-zA-Z]+)/g) {
  88         if (!$found{$1}) {
  89                 push @params, $1;
  90                 $found{$1}=1;
  91         }
  92 }
  93
  94 $ast = "Abstract Syntax Tree";
  95 @res = ();
  96 for $token (@params) {
  97         print STDERR "Parameter ~$token\n";
  98         #push @res, "//Start part $token\n";
  99 # first, sed starts from first line to the AST line and removes ~xxx and !xxx
 100         for $l (@lines) {
 101                 $_ = $l;
 102                 last if (/^$ast/);
 103                 s/[~!]$token//g;
 104                 push @res, $_;
 105         }
 106         #push @res, "//Generated part $token\n";
 107         # second, sed clones ~xxx parametrized productions, substitute ~xxx with _xxx and delete !xxx lines
 108         $into = 0;
 109         for $l (@lines) {
 110                 $_ = $l;
 111                 $into = 1 if (/~$token/);
 112                 next if (!$into);
 113                 s/~$token/_$token/g;
 114                 next if /!$token/;
 115                 push @res, $_;
 116                 $into = 0 if (/;/);
 117         }
 118         #push @res, "//End of generated part $token\n";
 119
 120         # third, sed continues fron AST line to last line and remove ~xxx and !xxx
 121         $into = 0;
 122         for (@lines) {
 123                 $into = 1 if (/^$ast/);
 124                 next if (!$into);
 125                 push @res, $_;
 126         }
 127         #push @res, "//End part $token\n";
 128         @lines = @res;
 129         @res = ();
 130 }
 131 print "/* This file is autogenerated, do not modify it */";
 132 print (join "", @lines);