a-(b-c)的去括号算法

某友国庆前说需要这样的一个perl 模块
能把这样的字符串：
a-(b-c) 变成 a-b+c

今天重温了一下编译原理的知识

涂鸦如下版本：

package Parser;

use strict;
use Carp;
sub new {
 my ($class, $str) = @_;
 $str = '' if not defined $str;
 my $self = {_str => $str};
 bless $self, $class;
 return $self;
}

sub parse {
 my ($self, $str) = @_;
 $str = $self->{_str} if not defined $str;
 $str =~ s{\s}{}g;
 my @chars = split '', $str;
 my @stack = ();

while ( 1 ) {
  my $c = shift @chars;
  last if not defined $c;
  
  push @stack, $c;  
  tar_from_stack(\@stack); 
 } 

if (scalar @stack == 1 and ref $stack[0] eq 'HASH' and  $stack[0]->{KEY} eq 'E') {
  into_fuhao($stack[0], 1);
  return get_str($stack[0], '');   
 } else {
  croak "cannot parse the string: $str \n";  
 }
}

sub into_fuhao {
 my $rh_data = shift;
 my $symbol = shift;
 my $i = 0;
 for my $child ( @{ $rh_data->{childs} } ) {
  if (ref $child eq 'HASH') {
   into_fuhao($child, $symbol);
  } else {
   if ($child eq '-') {    
    $rh_data->{childs}->[$i] = '+';
    $symbol = $symbol * (-1);
   } elsif ($child le 'z' and $child ge 'a' and $symbol == -1) {
    $rh_data->{childs}->[$i] = '-'. $child;
   } elsif ($child le 'z' and $child ge 'a' and $symbol == 1) {
    $rh_data->{childs}->[$i] = '+'. $child;
   }
  }
  $i++;
 }

}

sub get_str {
 my $rh_data = shift;
 my $pre_str = shift;

for my $child ( @{ $rh_data->{childs} } ) {
  if (ref $child eq 'HASH') {
   my $str = get_str($child, $pre_str);
   $pre_str = $str;
  } elsif ($child =~ m{^[-+][a-z]$}i) {
   $pre_str .= $child;
  }  
 }
 return $pre_str;
}

sub get_key_from_stack {
 my $ra = shift;
 my $element = pop @$ra;
 return undef if not defined $element;
 if (ref $element eq 'HASH') {
  return ( $element, $element->{KEY} );
 } else {
  return ( $element, $element );
 }
}

sub tar_from_stack {
 my $ra = shift;

while (1) {
  return if scalar @$ra == 0;
  my ( $e1, $k1 ) = get_key_from_stack($ra);
  if ( $k1 ge 'a' and $k1 le 'z' ) {
   push @$ra, {KEY => 'E', childs => [$k1]};
   next;
  } else {
   if (scalar @$ra >= 1) {
    my ( $e2, $k2 ) = get_key_from_stack($ra);
    if ( $k2 . $k1 eq '-E' or $k2 . $k1 eq '+E') {
     if (scalar @$ra == 0) {
      push @$ra, {KEY => 'E', childs => [$e2, $e1]};
      next;
     } else {
      my ( $e3, $k3 ) = get_key_from_stack($ra); 
      if ($k3 eq 'E') {
       push @$ra, {KEY => 'E', childs => [$e3, $e2, $e1]};
       next;
      } elsif ($k3 ne '+' and $k3 ne '-' ) {
       push @$ra, $e3, {KEY => 'E', childs => [$e2, $e1]};      
       next;
      } else {
       push @$ra, $e3, $e2, $e1;       
       last;
      }
     }
    } else {
     if (scalar @$ra == 0) {
      push @$ra, $e2, $e1;           
      last;
     } else {
      my ( $e3, $k3 ) = get_key_from_stack($ra); 
      if ( $k3. $k2 . $k1 eq 'E+E' 
        or $k3. $k2 . $k1 eq '(E)'       
      ) {
       push @$ra, {KEY => 'E', childs => [$e3, $e2, $e1]};
       next;
      } else {
       push @$ra, $e3, $e2, $e1;              
       last;
      }
     }
    }    
   } else {
    push @$ra, $e1;
    last;
   }
  }  
 }
}

1;

模块的使用如下：

#!perl

use strict;
use Parser;

my $p = Parser->new('a-c+(c-d)-(b-a)-a-(b-(c-d))');
print $p->parse();