# C-to-English Grammar
#
# Warning: work-in-progress. Some things are incomplete or non-functional.
#
# todo: 
# 1. pointers to functions. (getting there)
# 2. preprocessor directives. (getting there)

{
  my @defined_types = ('`FILE`'); 
  my ($rule_name, @macros); 
}

startrule: 
      translation_unit 
          { 
            my $output = $item[-1];
            $output =~ s/\^L(\s*.?)/\L$1/g; # lowercase specified characters
            $output =~ s/\^U(\s*.?)/\U$1/g; # uppercase specified characters
            print $output;
          } 
      startrule(?)
    
translation_unit:
      comment
    | external_declaration 
    | function_definition
    | preproc[matchrule => 'translation_unit']

preproc: 
      '#' (definition 
        | undefinition  
        | inclusion  
        | line 
        | error
        | pragma 
        | preproc_conditional[matchrule => $arg{matchrule}])

definition: 
      macro_definition
    | 'define' identifier token_sequence(?) <skip: '[ \t]*'> "\n"
          {
            my $token_sequence = join('',@{$item{'token_sequence(?)'}});
            $return = "Define the macro $item{identifier}";
            $return .= " to mean $token_sequence" if $token_sequence;
            $return .= ".\n";
          }

macro_definition:
      'define' identifier '(' <leftop: identifier ',' identifier> ')' token_sequence <skip: '[ \t]*'> "\n"
          {
            my @symbols = @{$item[-5]}; 
            my $last; 
            push @macros, $item{identifier}; 
            $return = "Define the macro $item{identifier} "; 
            if ($#symbols > 0) { 
              $last = pop @symbols; 
              $return .= "with the symbols " . join(", ",@symbols) . " and $last "; 
            } else { 
              $return .= "with the symbol $symbols[0] "; 
            } 
            $return .= "to use the token sequence `$item{token_sequence}`.\n"; 
          } 

undefinition:
      'undef' identifier <skip: '[ \t]*'> "\n"
          { 
            @macros = grep { $_ ne $item{identifier} } @macros;
            $return = "\nAnnul the definition of $item{identifier}.\n";
          }

inclusion: 
      'include' '<' filename '>' <skip: '[ \t]*'> "\n"
          { $return = "\nInclude system file $item{filename}.\n"; }
    | 'include' '"' filename '"' <skip: '[ \t]*'> "\n"
          { $return = "\nInclude user file $item{filename}.\n"; }
    | 'include' token
          { $return = "\nImport code noted by the token $item{token}.\n"; }   

filename: 
      /[_\.\-\w\/]+/ 

line: 
      'line' constant ('"' filename '"'
          { $return = "and filename $item{filename}"; }
      )(?) <skip: '[ \t]*'> "\n"
          { $return = "\nThis is line number $item{constant} " . join('', @{$item[-3]}) . ".\n"; }

error:
      'error' token_sequence(?) <skip: '[ \t]*'> "\n"
          { $return = "Stop compilation with error \"" . join('', @{$item{'token_sequence(?)'}}) . "\".\n"; }

pragma: 
      'pragma' token_sequence(?) <skip: '[ \t]*'> "\n"
          {
            my $pragma = join('',@{$item{'token_sequence(?)'}}); 
            if ($pragma) { $pragma = ' "$pragma"'; }
            $return = "Process a compiler-dependent pragma$pragma.\n";     
          }

preproc_conditional: 
      if_line[matchrule => $arg{matchrule}] 
          { $rule_name = $arg{matchrule}; }
      <matchrule: $rule_name>(s?)
          { $return = $item{if_line} . join('',@{$item[-1]}); }
      (elif_parts[matchrule => $rule_name])(?)
      (else_parts[matchrule => $rule_name])(?)
          { $return .= join('',@{$item[-2]}) .  join('',@{$item[-1]}); }
      '#' 'endif' 
          { $return .= "End preprocessor conditional.\n"; }

if_line:
      'ifdef' identifier <skip: '[ \t]*'> "\n"
          { $return .= "If the macro $item{identifier} is defined, then ^L"; }
    | 'ifndef' identifier <skip: '[ \t]*'> "\n"
          { $return .= "If the macro $item{identifier} is not defined, then ^L"; }
    | 'if' constant_expression <skip: '[ \t]*'> "\n"
          { $return .= "If the preprocessor condition^L $item{constant_expression} is true, then ^L"; }

elif_parts:
      ('#' 'elif' constant_expression 
          { $return .= "Otherwise, if the preprocessor condition $item{constant_expression} is true, then ^L"; }
      (<matchrule: $rule_name> )[matchrule => $arg{matchrule}](s?)
          { $return .=  join('',@{$item[-1]}); }
      )(s) 
          { $return = join('', @{$item[-1]}); }
 
else_parts:
      '#' 'else' 
          { $rule_name = $arg{matchrule}; }
      (<matchrule: $rule_name>)[matchrule => $arg{matchrule}](s?)
          { $return = "Otherwise, ^L" . join('',@{$item[-1]}); }

token_sequence:
      token(s)
          { $return = join(' ', @{$item[1]}); }

token:
      <skip: '[ \t]*'> /\S+/ 
          { $return = $item[-1]; }

external_declaration:
      declaration 

function_definition:
      declaration_specifiers(?) declarator[context => 'function definition'] compound_statement[context => 'function definition'](?)
          {
            my $declaration_specifiers = join('', @{$item{'declaration_specifiers(?)'}}); 
            my $name = $item{declarator}->[0];
            my $parameter_list = $item{declarator}->[1];

            my $return_type;
            if(@{$item{declarator}} > 2) {
              $return_type = "$item{declarator}->[2] $declaration_specifiers";
            } else {
              $return_type = $declaration_specifiers;
            }

            $return = "\nLet $name be a ";
            $return .= $parameter_list;
            $return .= " $return_type.\nTo perform the function, ^L";
            $return .= join('', @{$item{'compound_statement(?)'}});
          } 

compound_statement:
      '{' declaration_list(?) statement_list(?) '}' 
          { 
            my $declaration_list = join('',@{$item{'declaration_list(?)'}}); 
            my $statement_list = join('',@{$item{'statement_list(?)'}}); 

            $return = "Begin new block.\n" if not $arg{context};

            if ($declaration_list) { 
              $return .= $declaration_list; 
            }

            if ($statement_list ) { 
              $return .= $statement_list;   
            } else {
              $return .= "Do nothing.\n";
            } 

            $return .= "End block.\n" if not $arg{context};

            if ($arg{context} 
                and $arg{context} ne 'do loop'
                and $arg{context} ne 'case'
                and $arg{context} ne 'function definition') { 
              $return .= "End $arg{context}.\n";
            } 
            1;
          }

statement_list:
      comment(?) preproc[matchrule => 'statement'](?) statement[context => undef]
               {
                 my $preproc = join('',@{$item{'preproc(?)'}}); 
                 my $comment = join('',@{$item{'comment(?)'}}); 

                 $return = $item{statement};
   
                 if ($comment) { $return = $comment . $return; }  
                 if ($preproc) { $return = $preproc . $return; } 
               } 
        statement_list(?)
               { $return .= join('',@{$item{'statement_list(?)'}}); }

statement: 
      jump_statement
    | compound_statement
    | iteration_statement
    | selection_statement
    | labeled_statement
    | expression_statement

iteration_statement:
      'for' '(' <commit> for_initialization(?) ';' for_expression(?) ';' for_increment(?) ')'    
        statement[context => 'for loop']
          { 
            my $initialization = join('', @{$item{'for_initialization(?)'}}); 
            my $item_expression = join('',@{$item{'for_expression(?)'}}); 
            my $increment = join('',@{$item{'for_increment(?)'}}); 

            if ($initialization) { 
              $return .= "Prepare a loop by ^L$initialization, then ^L"; 
            }

            if ($item_expression) { 
              $return .= "For as long as $item_expression, ^L"; 
            } else {
              $return .= "Repeatedly ^L";
            } 

            $return .= $item{statement} ; 

            if ($increment) { 
              $return =~ s/End for loop.$//;
              $return .= "After each iteration, ^L$increment.\n"; 
            } 
          } 
    | 'while' '(' <commit> expression  ')' statement[context => 'while loop']  
          { 
            if($item{expression} =~ /(^\d+$)/) {
              if($1 == 0) {
                $return = "Never ^L";
              } else {
                $return = "Repeatedly ^L";
              }
            } else {
              $return = "While $item{expression}, ^L"; 
            }

            if($item{statement}) {
              $return .= $item{statement} . "\n"; 
            } else {
              $return .= "do nothing.\n";
            }
          } 
    | 'do' statement[context => 'do loop'] 'while' '(' expression ')' ';' 
          { $return = "Do the following:^L $item{statement}Do this as long as $item{expression}.\n"; }

for_initialization:
      expression[context => 'for loop']

for_expression:
      expression[context => 'for_expression']

for_increment:
      expression[context => 'statement'] 

selection_statement:
      'if' <commit> '(' expression[context => 'if block'] ')' statement[context => 'if block'] 
          { 
            if($item{expression} =~ /^(\d+)$/) {
              if($1 == 0) {
                $item{expression} = "never";
              } else {
                $item{expression} = "always";
              }
            }
            $return = "If $item{expression} then ^L$item{statement}";
          }
      ('else' statement[context => 'else block']
          { $return = "Otherwise, ^L$item{statement}"; }
      )(?)
          { $return .= join('',@{$item[-1]}); }
    | 'switch'  '(' expression ')'  statement[context => 'switch']  
          { $return = "Given the expression \'$item{expression}\',\n^L$item{statement}"; }

jump_statement: 
      'break' ';'   
          { 
            if($arg{context} eq 'switch' or $arg{context} eq 'case') {
              $return = "Break case.\n";
            } elsif(length $arg{context}) {
              $return = "Break from the $arg{context}.\n";
            } else {
              $return = "Break from the current block.\n";
            }
          } 
    | 'continue' ';'
          { $return = "Return to the top of the current loop.\n"; } 
    | 'return' <commit> expression[context => 'return'](?) ';' 
          {
            my $item_expression = join('', @{$item{'expression(?)'}});

            if (length $item_expression) { 
              $return = "Return ^L$item_expression.\n";
            } else {
              $return = "Return no value.\n";
            }
          }
    | 'goto' <commit> identifier ';' comment(?)
          { 
            $return = "Go to the label named $item{identifier}.\n";
            $return .= join('', @{$item{'comment(?)'}});
          }

expression_statement:
      expression[context => 'statement'](?) ';'
          { 
            my $item_expression = join('',@{$item[1]}); 
            if (!$item_expression) { 
              if($arg{context} eq 'label') {
                return "";
              } else {
                $return = "Do nothing.\n"; 
              }
            } else { 
              $return = $item_expression.".\n" ; 
            } 
          }

labeled_statement:
      identifier ':' statement[context => 'label'] (';')(?)
          { $return = "Let there be a label $item{identifier}.\n$item{statement}"; }
    | 'case' constant_expression ':' statement[context => 'case'] 
          { $return = "When it has the value $item{constant_expression}, ^L$item{statement}"; }
    | 'default' ':' statement 
          { $return = "In the default case, ^L$item{statement}"; } 

expression:
      <leftop: assignment_expression[context => $arg{context}] ',' assignment_expression[context => $arg{context}]>
          {
            $return = join(", then ^L",@{$item[-1]}); 
          }

assignment_expression:
      unary_expression[context => 'assignment_expression'] 
        assignment_operator[context => $arg{context}] 
        assignment_expression[context =>  'assignment_expression'] 
          {
            my $assignment_expression = $item{assignment_expression}; 
            my $assignment_operator = $item{assignment_operator};

            if ($arg{context} eq 'statement' or $arg{context} eq 'for loop') {
              $return .= "${$item{assignment_operator}}[0] $item{unary_expression} ";
              $return .= "${$item{assignment_operator}}[1] " if $assignment_expression !~ /the result of/;
              $return .= $assignment_expression;
            } else {
              $return = "$item{unary_expression} $assignment_operator $assignment_expression"; 
            } 
          } 
    | conditional_expression[context => $arg{context}]

conditional_expression:
      logical_OR_AND_expression[context => $arg{context}] conditional_ternary_expression
          {
            if($item{conditional_ternary_expression}) {
              my $op1 = $item{conditional_ternary_expression}->[0];
              my $op2 = $item{conditional_ternary_expression}->[1];
              my $istrue = $item{logical_OR_AND_expression} =~ /(greater|less|equal)/ ? '' : ' is true';
              $return = "$op1 if $item{logical_OR_AND_expression}$istrue otherwise to $op2";
            } else {
              $return = $item{logical_OR_AND_expression};
            }
          }

conditional_ternary_expression:
      '?' expression ':' conditional_expression
          { $return = [$item{expression}, $item{conditional_expression}]; } 
    | {""}

assignment_operator:
      '=' 
          {
            if ($arg{context} eq 'statement') { 
              $return = ['Assign to', 'the value' ]; 
            } elsif ($arg{context} eq 'for loop') {
              $return = ['assigning to', 'the value' ];
            } else { 
              $return = 'which is assigned to be'; 
            }
          }
    | '+=' 
          {
            if ($arg{context} eq 'statement') { 
              $return = ['Increment','by'];
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['incrementing','by'];
            } else { 
              $return = 'which is incremented by'; 
            }
          }
    | '-='
          {
            if ($arg{context} eq 'statement') { 
              $return = ['Decrement' , 'by']; 
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['decrementing' , 'by']; 
            } else { 
              $return = 'which is decremented by'; 
            }
          }
    | '*='
          {
            if ($arg{context} eq 'statement') { 
              $return = ['Multiply' , 'by'];  
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['multiplying' , 'by'];
            } else { 
              $return = 'which is multiplied by'; 
            }
          }
    | '/='
          { 
            if ($arg{context} eq 'statement') {  
              $return = ['Divide' , 'by' ]; 
            } elsif ($arg{context} eq 'for loop') {  
              $return = ['dividing' , 'by' ]; 
            } else { 
              $return = 'which is divided by'; 
            }
          }
    | '%=' 
          { 
            if ($arg{context} eq 'statement') { 
              $return = ['Reduce', 'to modulo '] ;  
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['reducing', 'to modulo '] ;  
            } else { 
              $return = 'which is reduced to modulo'; 
            }
          }
    | '<<='
          { 
            if ($arg{context} eq 'statement') { 
              $return = ['Bit-shift', 'left by'];  
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['bit-shifting', 'left by'];  
            } else { 
              $return = 'which is bit-shifted left by'; 
            }
          }
    | '>>='
          { 
            if ($arg{context} eq 'statement') { 
              $return = ['Bit-shift', 'right by'];  
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['bit-shifting', 'right by'];  
            } else { 
              $return = 'which is bit-shifted right by'; 
            }
          }
    | '&='
          { 
            if ($arg{context} eq 'statement') { 
              $return = ['Bit-wise ANDed', 'by' ];  
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['bit-wise ANDing', 'by' ];  
            } else { 
              $return = 'which is bit-wise ANDed by'; 
            }
          }
    | '^='
          { 
            if ($arg{context} eq 'statement') { 
              $return = ['Exclusive-OR','by'];
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['exclusive-ORing','by'];
            } else { 
              $return = 'which is exclusive-ORed by'; 
            }
          }
    | '|='
          { 
            if ($arg{context} eq 'statement') { 
              $return = ['Bit-wise ORed', 'by'];  
            } elsif ($arg{context} eq 'for loop') { 
              $return = ['bit-wise ORing', 'by'];  
            } else { 
              $return = 'which is bit-wise ORed by'; 
            }
          }

constant_expression:
      conditional_expression

logical_OR_AND_expression:
      <leftop:
        rel_add_mul_shift_expression[context => $arg{context}]
        log_OR_AND_bit_or_and_eq
        rel_add_mul_shift_expression[context => 'logical_OR_AND_expression']>
          {
            if (defined $arg{context} and $arg{context} eq 'for_expression') { print STDERR "hmm2\n"; }
            my @ands = @{$item[1]}; 
            $return = join ('' , @ands);
          } 

log_OR_AND_bit_or_and_eq: 
      '||' { $return = ' or '; }
    | '&&' { $return = ' and '; }
    | '|'  { $return = ' bitwise-ORed by '; }
    | '&'  { $return = ' bitwise-ANDed by '; }
    | '^'  { $return = ' bitwise-XORed by ';}
    | '==' { $return = ' is equal to ' ; }
    | '!=' { $return = ' is not equal to ' ; } 

rel_mul_add_ex_op: 
      '+'  { $return = ' plus '; }
    | '-'  { $return = ' minus '; }
    | '*'  { $return = ' times '; }
    | '/'  { $return = ' divided by '; }
    | '%'  { $return = ' modulo '; }
    | '<<' { $return = ' shifted left by '; }
    | '>>' { $return = ' shifted right by '; }
    | '>=' { $return = ' is greater than or equal to '; }
    | "<=" { $return = ' is less than or equal to '; }
    | '>'  { $return = ' is greater than '; }
    | '<'  { $return = ' is less than '; }

unary_operator: 
      '&' { $return = 'the address of '; }
    | '*' { $return = 'the contents of '; }
    | '+' { $return = ''; }
    | '-' ...constant { $return  = 'negative '; }
    | '-' { $return = 'minus '; }
    | '~' { $return = "the one's complement of "; }
    | '!' { $return = 'the logical negation of '; }


rel_add_mul_shift_expression:
      cast_expression[context => $arg{context}] ...';'
          { $return = $item{cast_expression}; }
    | <leftop:
        cast_expression[context => $arg{context}]
        rel_mul_add_ex_op
        cast_expression[context => 'add_mul_shift_expression'] >
          {
            my @ands = @{$item[1]}; 
            $return = join ('' , @ands);
          } 

closure: 
      ',' | ';' | ')' 

cast_expression:
      '(' type_name ')' cast_expression[context => 'recast']
          { $return = "$item{cast_expression} type-casted as $item{type_name}"; }
    | unary_expression[context => $arg{context}] 
          { $return = $item{unary_expression}; } 

declaration_list: 
      preproc[context => 'statement'](?) declaration(s) 
          { $return = join('', @{$item{'preproc(?)'}}) . join('', @{$item{'declaration(s)'}}); }

declaration:
      declaration_specifiers init_declarator_list(?) ';'
          {
            my @init_list = defined $item{'init_declarator_list(?)'}->[0] ? @{$item{'init_declarator_list(?)'}->[0]} : ('');
            my $init_declaration_list;

            if ($item{declaration_specifiers} =~ s/type definition of //) {
              if(@init_list > 1) {
                my $last = pop @init_list;
                $init_declaration_list = join(', ', @init_list) . ' and ' . $last;
                push @init_list, $last;
              } else {
                $init_declaration_list = $init_list[0];
              }

              $return = "Let $init_declaration_list be another name for $item{declaration_specifiers}.\n";

              push @defined_types, @init_list; 
            } else {
              my $inits = 0;
              while(@init_list) {
                $inits++;
                $return .= "Let " unless $arg{context} eq 'struct member';

                my @args = ::flatten shift @init_list;

                my ($first_qualifier, $first_initializer);
                my $first_identifier = shift @args;

                if(not length $first_identifier) {
                  $first_identifier = 'there';
                }

                my @identifiers = ($first_identifier);

                my $next_arg = shift @args;
                if($next_arg =~ m/initialized/) {
                  $first_initializer = $next_arg;
                  $first_qualifier = shift @args // '';
                } else {
                  $first_qualifier = $next_arg;
                  $first_initializer = shift @args // '';
                }

                if($first_initializer !~ /^initialized/) {
                  $first_qualifier .= " $first_initializer" if $first_initializer;
                  $first_initializer = '';
                }

                my $remaining_args = join(' ', @args);

                my @initializers;
                if($first_initializer) {
                  push @initializers, [ $first_identifier, $first_initializer ];
                }
                
                for(my $i = 0; $i < @init_list; $i++) {
                  @args = ::flatten $init_list[$i];

                  my ($qualifier, $initializer);
                  my $identifier = shift @args;

                  $next_arg = shift @args;
                  if($next_arg =~ m/initialized/) {
                    $initializer = $next_arg;
                    $qualifier = shift @args // '';
                  } else {
                    $qualifier = $next_arg;
                    $initializer = shift @args // '';
                  }

                  next unless $qualifier eq $first_qualifier;

                  push @identifiers, $identifier;
                  if($initializer) {
                    push @initializers, [ $identifier, $initializer ];
                  }

                  splice @init_list, $i--, 1;
                }

                if($arg{context} eq 'struct member') {
                  if($inits > 1 and not @init_list) {
                    $return .= ' and ';
                  } elsif($inits > 1) {
                    $return .= ', ';
                  }

                  if($first_qualifier) {
                    if($first_qualifier =~ /bit\-field/) {
                      $first_qualifier = "$item{declaration_specifiers} $first_qualifier";
                      $item{declaration_specifiers} = '';
                    }

                    if(@identifiers == 1 and $first_qualifier !~ /^(a|an)\s+/) {
                      $return .= $first_qualifier =~ m/^[aeiouy]/ ? 'an ' : 'a ';
                    } elsif(@identifiers > 1) {
                      $first_qualifier =~ s/pointer/pointers/;
                    }
                    $return .= "$first_qualifier $item{declaration_specifiers} ";
                  } else {
                    if(@identifiers == 1 and $item{declaration_specifiers} !~ /^(a|an)\s+/) {
                      $return .= $item{declaration_specifiers} =~ m/^[aeiouy]/ ? 'an ' : 'a ';
                    }
                    $return .= "$item{declaration_specifiers} ";
                  }

                  my $and = @identifiers > 1 ? ' and ' : '';
                  my $comma = '';
                  for(my $i = 0; $i < @identifiers; $i++) {
                    if($i == @identifiers - 1) {
                      $return .= "$and$identifiers[$i]";
                    } else {
                      $return .= "$comma$identifiers[$i]";
                      $comma = ', ';
                    }
                  }
                } else {
                  my $and = @identifiers > 1 ? ' and ' : '';
                  my $comma = '';
                  for(my $i = 0; $i < @identifiers; $i++) {
                    if($i == @identifiers - 1) {
                      $return .= "$and$identifiers[$i]";
                    } else {
                      $return .= "$comma$identifiers[$i]";
                      $comma = ', ';
                    }
                  }

                  $return .= ' be ';

                  if($first_qualifier) {
                    if(@identifiers == 1 and $first_qualifier !~ /^(a|an)\s+/) {
                      $return .= $first_qualifier =~ m/^[aeiouy]/ ? 'an ' : 'a ';
                    } elsif(@identifiers > 1) {
                      $first_qualifier =~ s/pointer/pointers/;
                    }
                    $return .= "$first_qualifier ";
                    $return .= "$remaining_args " if $remaining_args;
                    $return .= $item{declaration_specifiers};
                  } else {
                    if(@identifiers == 1 and $item{declaration_specifiers} !~ /^(a|an)\s+/) {
                      $return .= $item{declaration_specifiers} =~ m/^[aeiouy]/ ? 'an ' : 'a ';
                    }
                    $return .= "$remaining_args " if $remaining_args;
                    $return .= $item{declaration_specifiers};
                  }

                  if(@initializers) {
                    if(@identifiers > 1) {
                      $return .= ".\nInitialize ";

                      @initializers = sort { $a->[1] cmp $b->[1] } @initializers;
                      my ($and, $comma);

                      for(my $i = 0; $i < @initializers; $i++) {
                        my ($identifier, $initializer) = @{$initializers[$i]};

                        if($i < @initializers - 1 and $initializer eq $initializers[$i + 1]->[1]) {
                          $return .= "$comma$identifier";
                          $comma = ', ';
                          $and = ' and ';
                        } else {
                          $initializer =~ s/^initialized to //;
                          $return .= "$and$identifier to $initializer";
                          if($i < @initializers - 2) {
                            $and = $comma = ', ';
                          } else {
                            $and = ' and ';
                          }
                        }
                      }
                    } else {
                      $return .= " $initializers[0]->[1]";
                    }
                  }
                  $return .= ".\n";
                }
              }
            }
          }

init_declarator_list:
      <leftop: init_declarator ',' init_declarator> 

init_declarator:
      declarator[context => 'init_declarator']
          {
            $return = $item{declarator};
          }
      ('=' initializer)(?) 
          {
            my $init = join('',@{$item[-1]});  

            if (length $init) {
              $return = [$item{declarator}, "initialized to $init"]; 
            }
          }

initializer:
      comment(?) assignment_expression comment(?)
          {
            $return = $item[2]; 

            if (join('',@{$item[1]})) { 
              $return = '['.join('',@{$item[1]}).']' . $return;   
            }

            if (join('',@{$item[1]})) { 
              $return .= join('',@{$item[-1]}); 
            }
          } 
    | '{' comment(?) initializer_list (',' )(?) '}'
          { $return = 'the set ' . $item{'initializer_list'}; }

initializer_list:
      <leftop: initializer ',' initializer > 
          {
            my @inits = @{$item[1]};

           if ($#inits >1) { 
              my $init = pop @inits; 
              $return = join(', ',@inits) . ', and ' .$init; 
            } elsif ($#inits == 1) { 
              $return = $inits[0] . ' and ' . $inits[1]; 
            } else { 
              $return = $inits[0]; 
            } 
          }

unary_expression:
      postfix_expression[context => $arg{context}] 
          { $return = $item{postfix_expression}; }
    | '++' unary_expression
          {
            if ($arg{context} eq 'statement' ) {
              $return = "pre-increment $item{unary_expression}"; 
            } else { 
              $return = "the pre-incremented $item{unary_expression}";
            }
          }
    | '--' unary_expression  
          {
            if ($arg{context} eq 'statement' ) {
              $return = "Pre-decrement $item{unary_expression}"; 
            } else { 
              $return = "the pre-decremented $item{unary_expression}";
            }
          }
    | unary_operator cast_expression[context => $arg{context}]
          { $return = $item{unary_operator} . $item{cast_expression}; }
    |'sizeof' unary_expression 
          { $return = "the size of $item{unary_expression}"; }
    |'sizeof' '(' type_name ')' 
          { $return = "the size of the type $item{type_name}"; }

postfix_productions:
      '(' argument_expression_list(?) ')' postfix_productions[context => 'function call'](?)
          {
            my $postfix = $item[-1]->[0];

            if(not defined $arg{context} or $arg{context} ne 'statement') {
              $return = "the result of the function $arg{primary_expression}";
            } else {
              $return = "Call the function $arg{primary_expression} ";
            }

            # To discriminate between macros and functions. 
            foreach (@macros) { 
              if ($arg{primary_expression} eq $_) { 
                $return =~ s/Call/Insert/;
                $return =~ s/function/macro/; 
              }
            }

            my $arg_exp_list = join('',@{$item{'argument_expression_list(?)'}}); 
            if ($arg_exp_list) { 
              $return .= " with argument$arg_exp_list";
            }

            if($postfix) { 
              $return =~ s/^(Call|Insert)/the result of/;
              $return = "$postfix $return"; 
            }
            1;
          }
    | # array reference and plain expression
      ( '[' expression[context => 'array_address'] ']' 
          { $return = $item{expression}; } 
      )(s) postfix_productions[context => 'array_address'](?)
          {
            my $item_expression = '';
            if (@{$item[-2]}) { 
              $item_expression = join(' and ', @{$item[-2]}); 
            }

            my $postfix = $item[-1]->[0];

            if (length $item_expression) { 
              if($item_expression =~ /^\d+$/) {
                $item_expression++;
                my ($last_digit) = $item_expression =~ /(\d)$/;
                if($last_digit == 1) {
                  $item_expression .= 'st'; 
                } elsif($last_digit == 2) {
                  $item_expression .= 'nd';
                } elsif($last_digit == 3) {
                  $item_expression .= 'rd';
                } else {
                  $item_expression .= 'th';
                }
                if($arg{context} eq 'function call') {
                  $return = "the $item_expression element of";
                } else {
                  $return = "the $item_expression element of $arg{primary_expression}";
                }
              } elsif($item_expression =~ /^-\s*\d+$/) {
                $item_expression *= -1;
                my $plural = $item_expression == 1 ? '' : 's';
                $return = "the location $item_expression element$plural backwards from where $arg{primary_expression} points";
              } else {
                $return = "the element of $arg{primary_expression} at location $item_expression";
              }
            }

            if($postfix) {
              $return = "$postfix $return";
            }
          }
    | ('.' identifier)(s) postfix_productions[context => 'struct access'](?)
          { 
            my $identifier = join('',@{$item[-2]}); 
            my $postfix = $item[-1]->[0];

            if ($identifier) {
              if($arg{context} eq 'array_address') {
                $return = "member $identifier of";
              } else {
                $return = "the member $identifier of $arg{primary_expression}"; 
              }
            }

            if($postfix) {
              $return = "$postfix->[0] $return $postfix->[1]";
            }
          } 
    | ('->' identifier)(s) postfix_productions[context => 'struct access'](?) 
          {
            my $identifier = join('',@{$item[-2]}); 
            my $postfix = $item[-1]->[0];

            if ($identifier) {
              $return = "the member $identifier of the structure pointed to by $arg{primary_expression}"; 
            } 

            if($postfix) {
              $return = "$postfix->[0] $return $postfix->[1]";
            }
          }
    | ('++')(s)
          {
            my $increment = join('',@{$item[-1]}); 
            if ($increment) {
              if ($arg{context} eq 'statement') { 
                $return = "increment $arg{primary_expression} by one";
              } elsif($arg{context} eq 'struct access') {
                $return = ['increment', 'by one'];
              } else { 
                $return = "post-incremented $arg{primary_expression}";
              }
            }
          }
    | ('--')(s)
          {
            my $increment = join('',@{$item[-1]}); 
            if ($increment) {
              if ($arg{context} eq 'statement') { 
                $return = "decrement $arg{primary_expression} by one";
              } elsif($arg{context} eq 'struct access') {
                $return = ['decrement', 'by one'];
              } else { 
               $return = "post-decremented $arg{primary_expression}";
              }
            }
          }
    # having done the simplest cases, we go to the catch all for left recursions.
    | primary_expression postfix_suffix(s)
          {
            # is this ever reached?
            print STDERR "Untested code!\n"; 
            $return = $item{primary_expression} . "'s " . join('',@{$item{'postfix_suffix(s)'}}); 
          }
    | {""}

postfix_expression:
      primary_expression[context => $arg{context}] postfix_productions[primary_expression => $item[1], context => $arg{context}]
          {
            my $postfix_productions = $item{'postfix_productions'};

            if(length $postfix_productions) {
              $return = $postfix_productions;
            } elsif(length $item{primary_expression}) {
              $return = $item{primary_expression}; 
            } else {
              $return = undef;
            }
          }

postfix_suffix:
      ('[' expression ']')(s)
    | '.' identifier 
    | '->' identifier 
    | '++' 
    | '--' 

argument_expression_list:
      <leftop: assignment_expression[context => 'function argument'] ',' assignment_expression[context => 'function argument']>
          {
            my @arg_exp_list = @{$item[1]}; 
            my $last = ''; 
            if (@arg_exp_list > 2) {
              $last = pop @arg_exp_list; 
              $return = 's ' . join(', ', @arg_exp_list) . ", and $last";
            } elsif (@arg_exp_list == 2 ) { 
              $return = "s $arg_exp_list[0] and $arg_exp_list[1]";  
            } else {
              if ($arg_exp_list[0]) {
                $return = " $arg_exp_list[0]";
              } else {
                $return = '';
              }
            }
          }

narrow_closure:
      ';' | ',' | '->'

primary_expression:
      '(' expression ')' (...narrow_closure)(?)
          { 
            my $expression = $item{expression} ; 
            my $repeats = 1; 

            if ($expression =~ /^the expression (\(+)/) { 
              $repeats = (length $1) + 1; 
              $expression =~ s/^the expression \(+//;
            }

            $expression .= ')';
            $return = "the expression ";
            $return .= '(' x $repeats;
            $return .= $expression;
          }
    | constant
    | string 
    | identifier
    | {} # nothing

declarator:
      direct_declarator(s)
          { 
            my @direct_declarator = @{$item{'direct_declarator(s)'}};
            if(@direct_declarator == 1) {
              $return = $direct_declarator[0]; 
            } else {
              $return = $item{'direct_declarator(s)'}; 
            }
          }
    | pointer direct_declarator(s)
          { 
            push @{$item{'direct_declarator(s)'}}, $item{pointer};
            $return = $item{'direct_declarator(s)'};
          }

direct_declarator:
      identifier ':' constant
          { 
            my $bits = $item{constant} == 1 ? "$item{constant} bit" : "$item{constant} bits";
            $return = "$item{identifier}|bit-field of $bits";
          }
    | identifier[context => 'direct_declarator'] array_declarator(s?)
          { 
            if(@{$item{'array_declarator(s?)'}}) {
              $return = [$item{identifier}, join('', @{$item{'array_declarator(s?)'}})];
            } else {
              $return = $item{identifier};
            }
          }
    | '(' declarator ')' array_declarator(s)
          { 
            push @{$item{declarator}}, join('', @{$item{'array_declarator(s)'}});
            $return = $item{declarator};
          }
    | '(' parameter_type_list ')'
          { $return = "function taking $item{parameter_type_list} and returning"; }
    | '(' declarator array_declarator(s) ')'
          { $return = $item{'declarator'} . join('', @{$item{'array_declarator(s)'}}) }
    | '(' declarator ')' 
          { $return = $item{declarator}; }

array_declarator:
      ( '[' assignment_expression(?) ']'
          {
            if (@{$item{'assignment_expression(?)'}}) { 
              my $size = join('', @{$item{'assignment_expression(?)'}});
              if($size =~ /^(unsigned|long)*\s*1$/) {
                $return = "$size element ";
              } else {
                $return = "$size elements ";
              }
            } else { 
              $return = 'unspecified length ';
            }
          }
      )(s?)
          {
            my @array = @{$item[-1]};  
            if (@array) { 
              $return .= 'an array of ' . join('of an array of ' , @array) . 'of';
            } else {
              undef;
            }
          }

identifier_list:
      (identifier ',')(s?) identifier
          {
            my @identifier_list = @{$item[1]}; 
            if ($#identifier_list > 1) {
              $return = join(', ', @identifier_list) . ', and ' . $item{identifier};  
            } elsif ($#identifier_list == 1) { 
              $return = $identifier_list[1] . ' and ' . $item{identifier};  
            } else { 
              $return = $item{identifier};  
            }
          }

parameter_type_list:
      parameter_list

parameter_list:
      <leftop: parameter_declaration ',' parameter_declaration>
          {
            my @parameter_list = @{$item[1]};
            my $comma = '';
            for(my $i = 0; $i < @parameter_list; $i++) {
              $return .= $comma;
              if(ref $parameter_list[$i] eq 'ARRAY') {
                my @list = @{$parameter_list[$i]};
                if(@list == 0) {
                  $return = "no parameters";
                } elsif (@list ==  1) {
                  $return .= $list[0];
                } else {
                  $return .= join(' ', @list);
                }
              } else {
                $return .= $parameter_list[$i];
              }
              if($i == $#parameter_list - 1) {
                $comma = ' and ';
              } else {
                $comma = ', ';
              }
            }
          }

parameter_declaration:
      declaration_specifiers declarator 
          { $return = [$item{declaration_specifiers}, $item{declarator}]; }
    | '...'
          { $return = "variadic parameters"; }
    | declaration_specifiers abstract_declarator(?) 
    | ''
          { $return = "unspecified parameters"; }

abstract_declarator: 
      pointer 
    | pointer(?) direct_abstract_declarator 
          { $return = join('',@{$item{'pointer(?)'}}) . $item{direct_abstract_declarator}; }

direct_abstract_declarator:
      '(' abstract_declarator ')'
    | '[' ']'
    | '[' constant_expression ']'
    | DAD '[' ']'
    | DAD '[' constant_expression ']'
    | '(' ')'
    | '(' parameter_type_list ')'
    | DAD '(' ')'
    | DAD '(' parameter_type_list ')'

DAD: # macro for direct_abstract_declarator 
      ( '(' abstract_declarator ')' )(s?)
      ( '[' ']' )(s?)
      ( '[' constant_expression ']' )(s?)
      ( '(' ')' )(s?)
      ( '(' parameter_type_list ')' )(s?)

identifier: 
      ...!reserved identifier_word

pointer:
      '*' type_qualifier_list(s) pointer(?) 
          { 
            $return = join('', @{$item{'pointer(?)'}}) if @{$item{'pointer(?)'}};
            $return .= ' ' .  join('', @{$item{'type_qualifier_list(s)'}}) . ' pointer to ';
          }
    | '*' pointer(?) 
          { 
            $return = join('', @{$item{'pointer(?)'}});
            $return .= ' pointer to '; 
          } 
 
type_qualifier_list:
      type_qualifier(s) 
          { $return = join(' ', @{$item{'type_qualifier(s)'}}); }


declaration_specifiers:
      comment(?) type_specifier ...identifier
          { $return = join('', @{$item{'comment(?)'}}) . $item{type_specifier}; }
    | comment(?) storage_class_specifier declaration_specifiers(?) 
          {
            my $decl_spec =  join(' ', @{$item{'declaration_specifiers(?)'}});
            $return = join('',@{$item{'comment(?)'}}) . $item{storage_class_specifier} ;
            if ($decl_spec) { $return .=  ' ' . $decl_spec; } 
          }
    | comment(?) type_specifier declaration_specifiers(?) 
          {
            my $decl_spec = join(' ', @{$item{'declaration_specifiers(?)'}});
            $return = join('',@{$item{'comment(?)'}});
            $return .= "$decl_spec " if $decl_spec;
            $return .= $item{type_specifier};
          }
    | comment(?) type_qualifier declaration_specifiers(?) 
          {
            my $decl_spec = join(' ',@{$item{'declaration_specifiers(?)'}});
            $return = join('',@{$item{'comment(?)'}}) . $item{type_qualifier};
            $return .=  " $decl_spec" if $decl_spec;
          }

storage_class_specifier:
      'auto'
          { $return = "(auto)"; }
    | 'extern'
          { $return = "(declared elsewhere)"; }
    | 'static' 
          { $return = "(this declaration is not to be shared)"; }
    | 'register'
          { $return = "(suggestion to be as fast as possible)"; }
    | 'typedef'
          { $return = 'type definition of'; }

type_qualifier:
      'const'
          { $return = "constant"; }
    | 'volatile' 

type_specifier:
      'double'
    | 'short'
    | 'long'
    | 'char'
    | 'int' 
    | 'float'
    | 'void'
    | 'signed'
    | 'unsigned'
    | struct_or_union_specifier
    | enum_specifier
    | typedef_name 

typedef_name:
      identifier
          {
            my $answer = 0; 
            foreach (@defined_types) { 
              if ($item{identifier} eq $_) {
                $answer = 1;      
                $return = ($item{identifier} =~ m/^`[aeiouy]/ ? 'an ' : 'a ') . $item{identifier};
              } 
            }
            if (!$answer) { undef $answer; } 
            $answer;    
          }

struct_or_union_specifier:
      comment(?) struct_or_union identifier(?) '{' struct_declaration_list '}' 
          {
            my $identifier = join('',@{$item{'identifier(?)'}});
            $return = join('',@{$item{'comment(?)'}}) . $item{struct_or_union};
            if ($identifier) { $return .= " tagged $identifier"; } 
            my $plural = $item{struct_declaration_list} =~ / and / ? 's' : '';
            $return .= " with member$plural $item{struct_declaration_list}"; 
          }
    | struct_or_union identifier
          {
            $item{struct_or_union} =~ s/^(a|an)//;
            $return = $item{identifier} =~ m/^`[aeiouy]/ ? 'an' : 'a';
            $return .= " $item{identifier} $item{struct_or_union}";
          }

struct_declaration_list:
      struct_declaration(s)
          {
            my $finaldec;
            my @declarations = @{$item{'struct_declaration(s)'}}; 
            if ($#declarations > 1) { 
              $finaldec = pop @declarations; 
              $return = join(', ', @declarations ) . ', and ' . $finaldec ; 
            } elsif ($#declarations == 1) { 
              $return = join(' and ', @declarations);
            } else { 
              $return = $declarations[0]; 
            }
          } 

struct_declaration:
      comment(s?) declaration[context => 'struct member'] comment(s?)
          { $return = join('', @{$item[1]}) . $item{declaration} . join('', @{$item[-1]}); }

type_name:
      specifier_qualifier_list abstract_declarator(?)
          { $return = $item{specifier_qualifier_list}. join('',@{$item{'abstract_declarator(?)'}}); }

specifier_qualifier_list:
      type_specifier specifier_qualifier_list(?) 
          { 
            $return = $item{type_specifier};
            $return .= ' ' . join('', @{$item{'specifier_qualifier_list(?)'}}) if @{$item{'specifier_qualifier_list(?)'}};
          }

struct_or_union:
      comment(?) ('struct' 
          { $return = 'a structure'; }
        | 'union'
          { $return = 'an union'; }
      ) comment(?) 
          {
            shift @item; 
            foreach (@item) { 
              if (ref($_)) { 
                $return .= join('',@{$_}); 
              } else { 
                $return .= $_; 
              }
            }
          }

enum_specifier:
      'enum' identifier(?) '{' enumerator_list '}' 
          {
            $return .= 'an enumeration'; 

            if (@{$item{'identifier(?)'}}){ 
              $return .= ' of ' . join('',@{$item{'identifier(?)'}});
            }

            my @enumerator_list = @{$item{enumerator_list}};

            if(@enumerator_list == 1) {
              $return .= " comprising $enumerator_list[0]";
            } else {
              my $last = pop @enumerator_list; 
              $return .= ' comprising ' . join(', ', @enumerator_list) . " and $last"; 
            }

          }
    | 'enum' identifier
          { $return = "an enumeration of type $item{identifier}"; }


enumerator_list:
      <leftop:enumerator ',' enumerator>

enumerator:
      identifier ( '=' constant_expression )(?)
          {
            $return = $item[1]; 
             if (@{$item[-1]}) { 
               $return .= 'marking ' . join('', @{$item[-1]}); 
             }
           }

comment:
      comment_c 
    | comment_cxx

comment_c:
      m{/\*[^*]*\*+([^/*][^*]*\*+)*/}s
          {
            $return = $item[1];
            $return =~ s|^/\*+\s*||;
            $return =~ s|\s*\*+/$||;
            $return =~ s/"/\\"/g;
            $return = "\nA comment: \"$return\".\n"; 
          }

comment_cxx:
      m{//(.*?)\n}
          { 
            $return = $item[1]; 
            $return =~ s|^//\s*||;
            $return =~ s/\n*$//;
            $return =~ s/"/\\"/g;
            $return = "\nQuick comment: \"$return\".\n";
          }

constant:
      /-?[0-9]*\.[0-9]*[lf]{0,2}/i
          {
            if ($item[1] =~ s/f$//i) { 
              $return = "the floating point number $item[1]";
            } elsif ($item[1] =~ s/l$//i) {
              $return = "long double $item[1]";
            } else {
              $return = $item[1];
            }
          } 
    | /0x[0-9a-f]+[lu]{0,2}/i
          { 
            $return .= 'unsigned ' if $item[1] =~ s/[Uu]//; 
            $return .= 'long ' if $item[1] =~ s/[Ll]//; 
            $return = "the $return" . "hexadecimal number $item[1]";
          } 
    | /0\d+[lu]{0,2}/i
          {
            $return .= 'unsigned ' if $item[1] =~ s/[Uu]//; 
            $return .= 'long ' if $item[1] =~ s/[Ll]//; 
            $return = "the $return" . "octal number $item[1]";
          }
    |/-?[0-9]+[lu]{0,2}/i # integer constant
          {
            $return = $item[-1]; 
            $return = "long $return" if $return =~ s/[Ll]//; 
            $return = "unsigned $return" if $return =~ s/[Uu]//; 
          } 
    | /(?:\'((?:\\\'|(?!\').)*)\')/ # character constant
          {
            my $constant = $item[1];

            if($constant eq q('\n')) {
              $return = 'a newline';
            } elsif($constant eq q('\f')) {
              $return = 'a form-feed character';
            } elsif($constant eq q('\t')) {
              $return = 'a tab';
            } elsif($constant eq q('\v')) {
              $return = 'a vertical tab';
            } elsif($constant eq q('\b')) {
              $return = 'an alert character';
            } elsif($constant eq q('\r')) {
              $return = 'a carriage-return';
            } elsif($constant eq q('\b')) {
              $return = 'a backspace character';
            } elsif($constant eq q('\'')) {
              $return = 'a single-quote';
            } else {
              $return = $constant;
            }
          }
  # | enumeration_constant 
  # needs more.
 
integer_constant:
      /[0-9]+/ 

identifier_word:
      /[a-z_\$][a-z0-9_]*/i
          { $return = "`$item[-1]`"; }

string:
      /(?:\"(?:\\\"|(?!\").)*\")/

reserved: 
      'int' | 'double' | 'short' | 'volatile' | 'register' | 'float' | 'signed'
    | 'unsigned' | 'char' | 'for' | 'if' | 'switch' | 'while' | 'do' | 'case'
    | 'extern' | 'void' | 'exit' | 'return' | 'auto' | 'break' | 'const'
    | 'continue' | 'default' | 'else' | 'enum' | 'struct' | 'goto' | 'long'
    | 'register' | 'sizeof' | 'static' | 'typedef' | 'union'