#!/usr/bin/perl
use Text::RewriteRules;

use strict;

my $w=qr{\b\w+\b};
my $l=qr{\b[a-zA-Z]\b};
my $sexp=R::rr_re("sexp");

RULES a
($l)\(\s*($sexp)\s*\)==>$1 de $2

(\b(\d+|$l)\s*^\d+)=e=>R::rr_savit(sexp=>$1)
(\b\d+\s*$l)=e=>R::rr_savit(sexp=>$1)
(\b\d+\b)=e=>R::rr_savit(sexp=>$1)
($l)=e=>R::rr_savit(sexp=>$1)

($l)\((.*?)\)==>$1 de , abre , $2 , fecha
ENDRULES


while(<>){
 print "$_ =\n",a($_), "\n",R::rr_loadthem(a($_));
}

package S ;
my $base= 0x110000;

my %savit_p = ();
my %savit_n = ();
my %NT = ();

sub rr_re {
 if(@_){ qr{__RED$_[0]__\d+_} }
 else  { qr{__RED\w+__\d+_}   }
}

sub rr_value {
  my ($a) = @_;
  if( $a =~ m/__RED(\w+?)__(\d+)_/){ return $savit_p{$1}{$2};}
  else { return undef }
}

sub rr_class {
  my ($a) = @_;
  if( $a =~ m/__RED(\w+?)__(\d+)_/){ return $1;}
  else { return undef }
}

sub rr_savit {
  my ($cl,$a) = @_;
  $savit_p{$cl}{++$savit_n{$cl}} = $a ;
  "__RED${cl}__$savit_n{$cl}_"
}

sub rr_loadit {
  my ($cl,$a) = @_;
  $a =~ s/__RED${cl}__(\d+)_/$savit_p{$cl}{$2}/g;
  $savit_n{$cl}=0;
  $a;
}

sub rr_loadthem {
  my ($a) = @_;
  $a =~ s/__RED(\w+?)__(\d+)_/$savit_p{$1}{$2}/g;
  %savit_n = () ;
  $a;
}

1;

package R ;

my %savit_p = ();
my %savit_n = ();
my %NT = ();

sub rr_re {
 if(@_){ qr{__RED$_[0]__\d+_} }
 else  { qr{__RED\w+__\d+_}   }
}

sub rr_value {
  my ($a) = @_;
  if( $a =~ m/__RED(\w+?)__(\d+)_/){ return $savit_p{$1}{$2};}
  else { return undef }
}

sub rr_class {
  my ($a) = @_;
  if( $a =~ m/__RED(\w+?)__(\d+)_/){ return $1;}
  else { return undef }
}

sub rr_savit {
  my ($cl,$a) = @_;
  $savit_p{$cl}{++$savit_n{$cl}} = $a ;
  "__RED${cl}__$savit_n{$cl}_"
}

sub rr_loadit {
  my ($cl,$a) = @_;
  $a =~ s/__RED${cl}__(\d+)_/$savit_p{$cl}{$2}/g;
  $savit_n{$cl}=0;
  $a;
}

sub rr_loadthem {
  my ($a) = @_;
  $a =~ s/__RED(\w+?)__(\d+)_/$savit_p{$1}{$2}/g;
  %savit_n = () ;
  $a;
}

1;