#!/usr/bin/perl -w
# This file is part of NIT ( http://www.nitlanguage.org ).
#
# Copyright 2009 Jean Privat <jean@pryen.org>
# Copyright 2009 Jean-Sebastien Gelinas <calestar@gmail.com>
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

# prescc, a Sablecc preprocessor.
#
# Synopsis
#
#   Extends a sablecc grammar with parametrized productions and other syntactic stuff.
#
# Description
#
#   A production named foo~bar~baz semantically correspond to a production foo with two boolean parameters bar and baz
#   In fact foo is a family of 4 distinct productions: foo, foo_bar, foo_baz and foo_bar_baz
#   In a parametrized production with a parameter ~xxx:
#    * parameters (~xxx) are substituted with _xxx if the parameter is true and removed if the parameter is false
#    * guarded alternatives (!xxx) are disabled if the parameter is true
#
# Limitations
#
#   prescc is badly implemented in perl and is not robust.
#   Users must remember the following:
#    * parametrized productions MUST be terminated with a line containing only a single semicolon (;)
#    * parameters (~) and guards (!) in alternatives MUST correspond to a parameter of the enclosing production
#    * if required, names in transformations MUST contain the full invocation name (with all parameters)
#        foo bar_x~y~z_t baz {-> New p(foo, bar_x~y~z_t.q)}
#    * guards do not understand grammar, they just remove the whole line
#    * The AST MUST start with a line containing only "Abstract Syntax Tree"
#
# Example of the dangling else implementation:
#
#   stmt~withelse =
#                'if' expr 'then' stmt_withelse 'else' stmt~withelse |
#     !withelse  'if' expr 'then' stmt |
#                nop
#                ;

while (<>) {
	push @lines, $_;
}
$lines = join "", @lines;

$current = "";
for (@lines) {
	if (/^.*{\s*->\s*(\w+)\s*}/) {
		$current = $1;
	}
	$current = "" if /;/;
	next if ($current eq "");
	if (s/{\:(\w+)}/{$1}/) {
		$alt = $1;
		@newargs = ();
		while (/((\[(\w*)\])?:)?([\w~]+)(})?/g) {
			$id=defined $3?$3:$4;
			next if ((defined $1) && !(defined $3));
			next if (defined $5);
			$4 =~ /([a-z]+)/;
			$argalt = $1;
			if ($id eq $argalt) {
				push @newargs, "$id";
			} else {
				push @newargs, "$id.$argalt";
			}
		}
		chomp;
		$_ .= " {-> New $current.$alt(". join(", ", @newargs) .")}\n";
		s/([^\]])\:(\w+)/$1$2/g;
	}
}

# List all the available parameters in the extended grammar
@params = ();
while ($lines =~ /\~([a-zA-Z]+)/g) {
	if (!$found{$1}) {
		push @params, $1;
		$found{$1}=1;
	}
}

$ast = "Abstract Syntax Tree";
@res = ();
for $token (@params) {
	print STDERR "Parameter ~$token\n";
	#push @res, "//Start part $token\n";
# first, sed starts from first line to the AST line and removes ~xxx and !xxx
	for $l (@lines) {
		$_ = $l;
		last if (/^$ast/);
		s/[~!]$token//g;
		push @res, $_;
	}
	#push @res, "//Generated part $token\n";
	# second, sed clones ~xxx parametrized productions, substitute ~xxx with _xxx and delete !xxx lines
	$into = 0;
	for $l (@lines) {
		$_ = $l;
		$into = 1 if (/~$token/);
		next if (!$into);
		s/~$token/_$token/g;
		next if /!$token/;
		push @res, $_;
		$into = 0 if (/;/);
	}
	#push @res, "//End of generated part $token\n";

	# third, sed continues fron AST line to last line and remove ~xxx and !xxx
	$into = 0;
	for (@lines) {
		$into = 1 if (/^$ast/);
		next if (!$into);
		push @res, $_;
	}
	#push @res, "//End part $token\n";
	@lines = @res;
	@res = ();
}
print "/* This file is autogenerated, do not modify it */";
print (join "", @lines);
