use strict;
use warnings;

use List::Util qw( sum );

our %ATOM_WEIGHTS = ( C => 12, O => 16, Pb => 207 );


sub OnDestroyAction(&) {
   return OnDestroyAction->new($_[0]);
}

sub OnDestroyAction::new {
   my ($class, $action) = @_;
   return bless(\$action, $class);
}

sub OnDestroyAction::abort {
   my ($self) = @_;
   undef $$self;
}

sub OnDestroyAction::now {
   my ($self) = @_;
   my $action = $$self;
   undef $$self;
   $action->() if $action;
}

sub OnDestroyAction::DESTROY {
   my ($self) = @_;
   my $action = $$self;
   $action->() if $action;
}


{
   our $rv_compound;
   our $rv_group;
   our $rv_factor;
   our $rv_element;


   # Used to create local variables
   # in the classical sense of "local".

   our @symtab;


   # To bypass RE bug.
   no warnings 'regexp';


   # Definitions must not be combined with assignment.
   
   my $compound;
   my $group;
   my $factor;
   my $element;

   $compound = qr/
                  (?{ local $symtab_manager = new_symtab_manager() })

                  (?{ $symtab[0]->{sum} = 0; })
                  (?:
                     (??{ $group })
                     (?{ $symtab[0]->{sum} += $rv_group; })
                  )+

                  # Return value:
                  (?{ local $rv_compound = $symtab[0]->{sum}; })

                  (?{ $symtab_manager->now(); })
               /x;

   $group    = qr/
                  (??{ $element })
                  (??{ $factor  })

                  # Return value:
                  (?{ local $rv_group = $rv_element * $rv_factor; })
               /x;

   $factor   = qr/
                  (?:
                     (\d+)

                     # Return value (first prod):
                     (?{ local $rv_factor = $1 })
                  | 
                     # Nothing

                     # Return value (second prod):
                     (?{ local $rv_factor = 1 })
                  )
               /x;

   $element  = qr/
                  (?:
                     ([A-Z][a-z]*(?![a-z]))

                     # Return value (first prod):
                     (?{ local $rv_element = $ATOM_WEIGHTS{$1} })
                  | 
                     \(
                     (??{ $compound })
                     \)

                     # Return value (second prod):
                     (?{ local $rv_element = $rv_compound; })
                  )
               /x;


   sub weight {
      local $rv_compound;
      local $rv_group;
      local $rv_factor;
      local $rv_element;

      local @symtab;

      local *new_symtab_manager = sub {
         unshift(@symtab, {});
         return OnDestroyAction { shift(@symtab) };
      };

      my $rv;

      shift =~ /
                  # To bypass RE bug.
                  ()

                  (??{ $compound })

                  # Return value:
                  (?{ $rv = $rv_compound; })
               /x;

      return $rv;

   }
}

print("The weight of $_ is ", weight($_), ".\n")
   for 'Pb(CO3)2';

# Prints "The weight of Pb(CO3)2 is 327."
[download]

use strict;
use warnings;

use List::Util qw( sum );

our %ATOM_WEIGHTS = ( C => 12, O => 16, Pb => 207 );


{
   our $rv_compound;
   our $rv_compound_;
   our $rv_group;
   our $rv_factor;
   our $rv_element;


   # Definitions must not be combined with assignment.
   
   my $compound;
   my $compound_;
   my $group;
   my $factor;
   my $element;

   $compound  = qr/
                   (??{ $group     })
                   (??{ $compound_ })

                   # Return value:
                   (?{ local $rv_compound = $rv_group + $rv_compound_;
+ })
                /x;

   $compound_ = qr/
                   (?:
                      (??{ $group     })
                      (??{ $compound_ })

                      # Return value (first prod):
                      (?{ local $rv_compound_ = $rv_group + $rv_compou
+nd_; })
                   | 
                      # Nothing

                      # Return value (second prod):
                      (?{ local $rv_compound_ = 0; })
                   )
                /x;

   $group     = qr/
                   (??{ $element })
                   (??{ $factor  })

                   # Return value:
                   (?{ local $rv_group = $rv_element * $rv_factor; })
                /x;

   $factor    = qr/
                   (?:
                      (\d+)

                      # Return value (first prod):
                      (?{ local $rv_factor = $1 })
                   | 
                      # Nothing

                      # Return value (second prod):
                      (?{ local $rv_factor = 1 })
                   )
                /x;

   $element   = qr/
                   (?:
                      ([A-Z][a-z]*(?![a-z]))
 
                      # Return value (first prod):
                      (?{ local $rv_element = $ATOM_WEIGHTS{$1} })
                   | 
                      \(
                      (??{ $compound })
                      \)

                      # Return value (second prod):
                      (?{ local $rv_element = $rv_compound; })
                   )
                /x;


   sub weight {
      local $rv_compound;
      local $rv_compound_;
      local $rv_group;
      local $rv_factor;
      local $rv_element;

      my $rv;

      shift =~ /
                  # To bypass RE bug.
                  ()

                  (??{ $compound })

                  # Return value:
                  (?{ $rv = $rv_compound; })
               /x;

      return $rv;
   }
}

print("The weight of $_ is ", weight($_), ".\n")
   for 'Pb(CO3)2';
[download]