util/func_refact.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 use Storable;
   5 use Getopt::Long;
   6 use YAML;
   7
   8 GetOptions \our %Conf, qw(help|h nodes|n=s initial=s@ debug=s except=s@);
   9
  10 if ($Conf{help}) {
  11     print <<'END';
  12   run with -n filename containing nodes data produced by --nodes
  13 of graphfuncs.pl. Will print initial set sizes for all functions
  14 by default, or use -initial <fname>, possibly many times, to
  15 specify the initial set. -except <fname> introduces a function to
  16 ignore, can iterate. -debug <fname> is a function to print more
  17 information about as components are computed.
  18 END
  19     exit 0;
  20 }
  21
  22 our $nodes = YAML::LoadFile($Conf{nodes}) or
  23         die "can't load nodes data: $!";
  24
  25 our %ignoring;
  26
  27 $ignoring{$_} = 1 && print "Ignoring: $_\n" for (@{$Conf{except}});
  28
  29 if (+$Conf{initial}) {
  30         print "Initial set: " . join(' ', @{$Conf{initial}}) . "\n";
  31         doUnion (@{$Conf{initial}});
  32 } else {
  33         print "CC sizes:\n";
  34         for (keys %$nodes) {
  35             print "$_: " . union({$_=>1}, $_) . "\n";
  36         }
  37 }
  38 exit 0;
  39
  40 sub doUnion {
  41         my %ccset = map { $_ => 1 } @_;
  42         union (\%ccset, $_) for keys %ccset;
  43         print "doUnion: initial set size is " . scalar(keys %ccset) . "\n";
  44
  45         print "\nFinding candidates.\n\n";
  46
  47         candidates(\%ccset);
  48         #while (my $new = candidates(\%ccset)) {
  49         #    union(\%ccset, $new);
  50         #}
  51 }
  52
  53 sub union {
  54     my ($set, $new) = @_;
  55     my $oldsize = keys %$set;
  56     my $debug = $new eq ($Conf{debug}||="");
  57
  58     return 0 if $ignoring{$new};
  59
  60     my $size = scalar(keys %$set) - 1; # to force one run even if $new is in
  61     $set->{$new} = 1;
  62     while (scalar(keys %$set) > $size) {
  63         $size = keys %$set;
  64         for my $f (keys %$set) {
  65             for my $t (@{$nodes->{$f}}) {
  66                 next if $set->{$t} or $ignoring{$t};
  67                 print "unionising $new: adding $t on account of $f\n" if $Conf{verbose} or $Conf{debug} eq $new;
  68                 $set->{$t} = 1;
  69             }
  70         }
  71     }
  72     #print ::Y({post=>{set=>$set, new=>$new}});
  73     print "union: while adding $new, entered with $oldsize, leaving with $size\n"
  74         if $Conf{verbose} or $Conf{debug} eq $new;
  75     return $size - $oldsize; # new member count
  76 }
  77
  78 sub candidates {
  79     my %cands;
  80     my $ccset = shift;
  81     for my $cand (keys %$nodes) {
  82         #print "trying: $cand\n";
  83         next if exists $ccset->{$cand} or $ignoring{$cand};
  84         #print "passed: $cand\n";
  85         $cands{$cand} = [ scalar @{$nodes->{$cand}},
  86                          # total callees for func
  87           , union(Storable::dclone($ccset), $cand)];  # new contributions
  88         #print "$cand: totall $cands{$cand}[0] $cands{$cand}[1]\n";
  89     }
  90
  91     # print ten best candidates
  92     print_cand($_, $cands{$_}) for
  93         sort {score(@{$cands{$b}}) <=> score(@{$cands{$a}})}
  94         keys %cands;
  95
  96     # prompt the user
  97     # return list of newly selected functions
  98 }
  99
 100 sub print_cand {
 101     my ($cand, $data) = @_;
 102     my ($total, $new) = @$data;
 103     printf "$cand: %s ($total total, $new new)\n", score($total, $new);
 104 }
 105
 106 sub score {
 107     my ($total, $new) = @_;
 108     return 0 if $total == $new;
 109     ($total - $new) / $total;
 110 }
 111
 112 #sub clone { Load(Dump($_[0])) }
 113 sub ::Y { require YAML; YAML::Dump(@_) }
 114 sub ::YY { require Carp; Carp::confess(::Y(@_)) }