#!/usr/bin/perl

# make_grammar.pl: Creates Grammar.pm

use strict;
use warnings;

use Parse::RecDescent ();

my $grammar = <<'__END_OF_GRAMMAR__';
   {
      use strict;
      use warnings;

      use List::Util qw( sum );
	  
	  my %variables=();

      sub replicate {
	   my ($l, $r) = @_;
	   
	   my $lt = $l->[0];
	   my $rt = $r->[0];

	   die("Type error\n") if $lt ne 'list';
	   die("Type error\n") if $rt ne 'list';

	   my $ld = $l->[1];
	   my $rd = $r->[1];
	   
	   my @replicated;
	   my $value;
	   
	   foreach (@{$ld})
	   {
	    $value=$_; 
	    foreach(0..$#$rd){push @replicated, $value;}
	   }

	   return [list => \@replicated];
	  }
	  
	sub duplicate {
	   my ($l, $r) = @_;
	   
	   my $lt = $l->[0];
	   my $rt = $r->[0];

	   die("Type error\n") if $lt ne 'list';
	   die("Type error\n") if $rt ne 'list';

	   my $ld = $l->[1];
	   my $rd = $r->[1];
	   
	   my @duplicated;
	  
       foreach(0..$#$rd){push @duplicated, @{$ld};}
       return [list => \@duplicated];
	  }


     sub cross_prod {
         my ($l, $r) = @_;
		 my ($i, $j)=('','');
	
         my $lt = $l->[0];
         my $rt = $r->[0];

         die("Type error\n") if $lt ne 'list';
         die("Type error\n") if $rt ne 'list';

         my $ld = $l->[1];
         my $rd = $r->[1];

		 return [ list => [map { $i=$_; map { $j=$_;  $ld->[$i].$rd->[$j]} 0..$#$rd} 0..$#$ld]];
      }


      sub dot_prod {
         my ($l, $r) = @_;
 
		 my $l_is_string = $l->[0] eq 'string';
		 my $r_is_string = $r->[0] eq 'string';
		 my $l_is_list   = $l->[0] eq 'list';
		 my $r_is_list   = $r->[0] eq 'list';
		 my ($ld, $rd) = ($l->[1], $r->[1]);
		 
         if ($l_is_string && $r_is_string) {
		 return [ string => $ld.$rd ];
         }

         if ($l_is_list && $r_is_list) {
			die("Size error\n") if @$ld != @$rd;
	
            return [ list => [ map { $ld->[$_].$rd->[$_] } 0..$#$rd ] ];
         }

         if ($l_is_string && $r_is_list) {
		    return [ list => [ map { $ld.$_ } @$rd ] ];
		 }
		 
		 if ($l_is_list && $r_is_string) {
		    return [ list => [ map { $_.$rd } @$ld ] ];
		 }
      }
   }
   
   parse:    assignment EOF
		   | expr EOF
			 {
			  if($item[1]->[0] eq 'list')
			  {
			   map {print $_."\n";} @{$item[1]->[1]};
			  }
			  
			  if($item[1]->[0] eq 'string')
			  {print $item[1]->[1]."\n";}
			  
			  $return = $item[1];
			 }
   
   assignment: /\w+/ '->' <commit> expr {$variables{$item[1]}=$item[4];}
 
   expr   : term expr_[ $item[1] ]

   expr_  : '%%'   <commit> term expr_[ replicate($arg[0], $item[3]) ]
			|'%'   <commit> term expr_[ duplicate($arg[0], $item[3]) ]
			|'**'  <commit> term expr_[ cross_prod($arg[0], $item[3]) ]
            |'*'   <commit> term expr_[ dot_prod   ($arg[0], $item[3]) ]
            | term  <commit>     expr_[ dot_prod   ($arg[0], $item[1]) ]
            | { $arg[0] }

   term   : '{' <commit> mbody '}'   
             {
			  my @to_flatten = @{$item[3]};
			  my @flattened=();
			  my ($i, $j)=('','');
			  
			  foreach (@to_flatten)
			  {
			   $i=$_;
			   if($i->[0] eq 'list')
			   {
			    push @flattened, @{$_->[1]};
				next;
			   }
			   push @flattened, $i->[1];
			  }
			  
			  $return = [list => \@flattened];
			 }
			 
			 | VARIABLE
			 | STRING
			 			 

   mbody  : <leftop: expr ',' expr>

   # Tokens
   VARIABLE:  '$' <commit> /\w+/ '$' { $return = $variables{$item[3]}; }
   STRING : /[^\{\}\,\*\$\%]+/ { $return = [ string => $item[1]]; }
   EOF    : /\Z/


__END_OF_GRAMMAR__

Parse::RecDescent->Precompile($grammar, 'Grammar')
   or die("Bad grammar\n");