#!/usr/bin/perl -w
##################################################
#
# Outputs the whatnow_list to be included in gp.c
#
##################################################
$src = "..";
$special = "\@";

%funold = read_oldfun("$src/language/compat.c");
%gpold  = read_oldfun("$src/gp/gp_init.c");
for ( read_dico() )
{ my ($oldname,$name,$arg,$oldarg) = split(/$special/);
  if ($funold{$oldname}) { push(@funres, get_new($name,$oldarg,$arg)); next; }
  if ($gpold{$oldname})  { push(@gpres,  get_new($name,$oldarg,$arg)); next; }
  bug("5: $oldname\n");
}
print "/* generated by the perl script 'whatnow' */\n"
      . "static const whatnow_t whatnowlist[]={\n"
      . join(",\n",@funres) . ",\n\n" . join(",\n",@gpres) . "\n};\n";

sub get_new { my($name, $oldarg,$arg) = @_;
  return "_SAME" if ($name eq "=");
  return "_REMOV" if ($name eq "");
  return "{\"$name\",\"$oldarg\",\"$arg\"}";
}

sub bug { die "BUG$_[0]\n"; }
sub o_r { my($f) = $_[0]; open(IN,"<$f") || die "can't open $f\n"; }

sub read_oldfun {
  o_r($_[0]);
  my(%fun);
  while(<IN>) {
    if (/^entree.*old/../^$/) {
      next if (/^entree/ || /^$/);
      my(@line) = split(/\"/);
      my($first) = $line[1]; bug("1: $_") if (!$first);
      $fun{$first} = 1;
    }
  }
  close(IN); return %fun;
}

sub read_dico {
  o_r("$src/whatnow");
  my(@diclist);
  while(<IN>)
  {
    chop; if (/_/ || !/=/) { push(@diclist,"$_$special="); next; }
    print bug("2: $_") if (! /; *$/);

    chop;
    my(@tab) = split(//);
    my($paren) = 0;
    my($pre, $post) = ("","");
    my($c) = 0;
    for (@tab)
    {
      if ($_ eq '(') { $paren++; }
      elsif ($_ eq ')') { $paren--; }
      elsif ($_ eq '=')
      {
        if (!$paren)
        {
          $pre = join("",@tab[0..$c-1]);
          $post = join("",@tab[$c+1..$#tab]);
          last;
        }
      }
      $c++;
    }
    $old = $pre;
    bug("3: $_") if ($post !~ /([^(]*)(.*)/);
    $name = $1; $arg = $2;
    bug("4: $_") if ($old !~ /([^(]*)(.*)/);
    $oldname = $1; $oldarg = $2;
    push(@diclist, "$oldname$special$name$special$arg$special$oldarg");
  }
  close(IN); return @diclist;
}
