#!/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 );

      sub cross_prod {
         my ($l, $r) = @_;

         my $lt = $l->[0];
         my $rt = $r->[0];

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

         my $lm = $l->[1];
         my $rm = $r->[1];

         die("Size error\n") if @$lm != @$rm;

         return [ number => sum map { $lm->[$_] * $rm->[$_] } 0..$#$lm ];
      }


      sub dot_prod {
         my ($l, $r) = @_;

         my $l_is_num = $l->[0] eq 'number';
         my $r_is_num = $r->[0] eq 'number';

         if ($l_is_num && $r_is_num) {
            my $ln = $l->[1];
            my $rn = $r->[1];
            return [ number => $ln * $rn ];
         }

         if (!$l_is_num && !$r_is_num) {
            my $lm = $l->[1];
            my $rm = $r->[1];

            die("Size error\n") if @$lm != @$rm;

            return [ matrix => [ map { $lm->[$_] * $rm->[$_] } 0..$#$lm ] ];
         }

         my ($n, $m) = ($l_is_num
            ? ($l->[1], $r->[1])
            : ($r->[1], $l->[1])
         );

         return [ matrix => [ map { $n * $_ } @$m ] ];
      }
   }

   parse  : expr EOF { $item[1] }

   #
   # expr and expr_ are used instead of the
   # following left-recursive rule (because
   # P::RD can't handle left-recursion):
   #
   #    expr : expr 'x' term { cross_prod($item[1], $item[3]) }
   #         | expr '*' term { dot_prod  ($item[1], $item[3]) }
   #         | expr     term { dot_prod  ($item[1], $item[2]) }
   #         |          term
   # 

   expr   : term expr_[ $item[1] ]

   expr_  : 'x'  <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> expr  ')' { $item[3] }
          | '{' <commit> mbody '}' { [ matrix => $item[3] ] }
          | NUMBER                 { [ number => $item[1] ] }

   mbody  : <leftop: NUMBER ',' NUMBER>


   # Tokens

   NUMBER : /\d+/ { 0+$item[1] }

   EOF    : /\Z/


__END_OF_GRAMMAR__

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