#!/usr/bin/perl

use Data::Dumper;

my $rule = ' $_ IOF $X /\ $_ BT "foo bar" ==> remove($_ BT "foo bar") /\ add($_ BT $X) ';

my $rule2 = ' $_ IOF $X /\ $_ BT "foo bar" ==> sub { my $self = shift; } ';

print Dumper(parse($rule));

sub parse {
  my $rule = shift;
  $rule = trim($rule);
  my @terms;

  my ($lhs, $rhs) = split /\s*==>\s*/, $rule;

  $lhs = [ split /\s*\/\\\s*/, $lhs];

  if ($rhs =~ m!sub\s*\{!) {
  } else {
    $rhs = [ split /\s*\/\\\s*/, $rhs];

    my $sub = "sub {\n\tmy \$self = shift;\n\tmy \%parm = \@_;";
    my @done = ();

    for (@$rhs) {
      if (m!(add|remove)\((.*)\)!) {

	my ($fun,$exp) = ($1,$2);
	$exp =~ s!"([^"]+)"!push @terms, $1; "\"".$#terms."\""!ge;
	$exp = [map { s/"(\d+)"/$terms[$1]/; $_ } split /\s+/, $exp];

	for my $var (grep { m!^\$! } @$exp) {
	  unless (grep { $_ eq $var } @done) {
	    push @done, $var;
	    $sub .= "\n\tmy ${var}_ = \$parm{'$var'};";
	  }
	}

	$sub .= "\n\t\$self->${fun}Relation(".join(",",map {m!^\$!?"${_}_":"\"$_\""} @$exp).");";

      } else {
	die "Error parsing rule\n"
      }
    }
    $rhs = $sub . "\n}";
  }

  for (@$lhs) {
    s!"([^"]+)"!push @terms, $1; "\"".$#terms."\""!ge;
    $_ = [map { s/"(\d+)"/$terms[$1]/; $_ } split /\s+/];
  }

  return { lhs => $lhs, rhs => $rhs }
}

sub trim {
  my $x = shift;
  for ($x) {
    s!^\s*!!;
    s!\s*$!!;
  }
  return $x;
}

__END__

para cada termo

  instancia(term x lhs) ==> ( var -> valor)*
               [ { $_ => "a", $x => "b" },
                 { $_ => "a", $x => "c" },]

  aplica( ( var -> valor)* , rhs ) --> (altera thesaurus)