prune_elm

#!/usr/local/bin/perl -w
use strict;
use Rsynth::Elements;
read_elements();

my @seq;
sub NULL () { undef }

sub enter
{
 my ($ph,@elem) = @_;
 push(@seq,[$ph,@elem]);
}

sub COMMENT
{
 my ($c) = @_;
 push(@seq,$c); 
}

do "phtoelm.def";
die $@ if $@;

my @list = @eNames;
while (@list)
 {
  my $e1 = shift(@list);
  foreach my $e2 (@list)
   {
    if (my $why = differ($e1,$e2))
     {
      #warn "$e1 differs from $e2 on $why\n";
     } 
    else
     {
      warn "$e1 seems to be same as $e2\n";
     } 
   } 
 }
 
sub differ
{
 my ($e1,$e2) = @_;
 foreach my $k (qw(rk))
  {
   return $k if $elem{$e1}{$k} != $elem{$e2}{$k};
  }
  
 my $f1 = join('|',grep { $_ } sort keys %{$elem{$e1}{features}}); 
 my $f2 = join('|',grep { $_ } sort keys %{$elem{$e2}{features}}); 
 
 foreach my $p (@pNames)
  {
   for my $i (0..4)
    {
     if ($elem{$e1}{$p}[$i] != $elem{$e2}{$p}[$i])
      {
       if ($f1 eq $f2)
        {
	 warn "$e1 and $e2 differ on $p\[$i] but share $f1\n";
	} 
       return "$p\[$i\]";
      } 
    }
  }
  
 foreach my $k (qw(rk du ud))
  {
   if ($elem{$e1}{$k} != $elem{$e2}{$k})
    {
     warn "$e1 and $e2 seem same except for $k\n";
     return $k; 
    }
  }
  
 
 if ( $f1 ne $f2 )
  {
   warn "$e1 and $e2 seem same except for $f1 vs $f2\n";
  } 
 return ""; 
} 

my %seen;
my @names;

foreach my $p (@seq)
 {
  next unless ref($p);
  my ($ph,@elem) = @$p;
  foreach my $e (@elem)
   {
    last unless defined $e;
    die "$ph needs $e" unless exists $elem{$e};
    unless ($seen{$e}++)
     {
      # warn "Add $e for $ph\n";
      push(@names,$e);
     }
   }
 }
 
foreach my $e (@eNames) 
 {
  unless (exists $seen{$e})
   {
    warn "$e not used by any phone\n";
    push(@names,$e);
   }
 }
 
@eNames = @names; 


write_elements("Elements.new");