Reid Spencer | f2722ca | 2006-03-22 15:59:55 +0000 | [diff] [blame^] | 1 | #!/usr/bin/perl |
| 2 | # |
| 3 | # Program: find-cycles.pl |
| 4 | # |
| 5 | # Synopsis: Given a list of possibly cyclic dependencies, merge all the |
| 6 | # cycles. This makes it possible to topologically sort the |
| 7 | # dependencies between different parts of LLVM. |
| 8 | # |
| 9 | # Syntax: find-cycles.pl < LibDeps.txt > FinalLibDeps.txt |
| 10 | # |
| 11 | # Input: cycmem1: cycmem2 dep1 dep2 |
| 12 | # cycmem2: cycmem1 dep3 dep4 |
| 13 | # boring: dep4 |
| 14 | # |
| 15 | # Output: cycmem1 cycmem2: dep1 dep2 dep3 dep4 |
| 16 | # boring: dep4 |
| 17 | # |
| 18 | # This file was written by Eric Kidd, and is placed into the public domain. |
| 19 | # |
| 20 | |
| 21 | use strict; |
| 22 | use warnings; |
| 23 | |
| 24 | my %DEPS; |
| 25 | my @CYCLES; |
| 26 | sub find_all_cycles; |
| 27 | |
| 28 | # Read our dependency information. |
| 29 | while (<>) { |
| 30 | chomp; |
| 31 | my ($module, $dependency_str) = /^([^:]*): ?(.*)$/; |
| 32 | die "Malformed data: $_" unless defined $dependency_str; |
| 33 | my @dependencies = split(/ /, $dependency_str); |
| 34 | $DEPS{$module} = \@dependencies; |
| 35 | } |
| 36 | |
| 37 | # Partition our raw dependencies into sets of cyclically-connected nodes. |
| 38 | find_all_cycles(); |
| 39 | |
| 40 | # Print out the finished cycles, with their dependencies. |
| 41 | my @output; |
| 42 | foreach my $cycle (@CYCLES) { |
| 43 | my @modules = sort keys %{$cycle}; |
| 44 | |
| 45 | # Merge the dependencies of all modules in this cycle. |
| 46 | my %dependencies; |
| 47 | foreach my $module (@modules) { |
| 48 | @dependencies{@{$DEPS{$module}}} = 1; |
| 49 | } |
| 50 | |
| 51 | # Prune the known cyclic dependencies. |
| 52 | foreach my $module (@modules) { |
| 53 | delete $dependencies{$module}; |
| 54 | } |
| 55 | |
| 56 | # Warn about possible linker problems. |
| 57 | my @archives = grep(/\.a$/, @modules); |
| 58 | if (@archives > 1) { |
| 59 | print STDERR "find-cycles.pl: Circular dependency between *.a files:\n"; |
| 60 | print STDERR "find-cycles.pl: ", join(' ', @archives), "\n"; |
| 61 | print STDERR "find-cycles.pl: Some linkers may have problems.\n"; |
| 62 | push @modules, @archives; # WORKAROUND: Duplicate *.a files. Ick. |
| 63 | } |
| 64 | |
| 65 | # Add to our output. (@modules is already as sorted as we need it to be.) |
| 66 | push @output, (join(' ', @modules) . ': ' . |
| 67 | join(' ', sort keys %dependencies) . "\n"); |
| 68 | } |
| 69 | print sort @output; |
| 70 | |
| 71 | |
| 72 | #========================================================================== |
| 73 | # Depedency Cycle Support |
| 74 | #========================================================================== |
| 75 | # For now, we have cycles in our dependency graph. Ideally, each cycle |
| 76 | # would be collapsed down to a single *.a file, saving us all this work. |
| 77 | # |
| 78 | # To understand this code, you'll need a working knowledge of Perl 5, |
| 79 | # and possibly some quality time with 'man perlref'. |
| 80 | |
| 81 | my %SEEN; |
| 82 | my %CYCLES; |
| 83 | sub find_cycles ($@); |
| 84 | sub found_cycles ($@); |
| 85 | |
| 86 | sub find_all_cycles { |
| 87 | # Find all multi-item cycles. |
| 88 | my @modules = sort keys %DEPS; |
| 89 | foreach my $module (@modules) { find_cycles($module); } |
| 90 | |
| 91 | # Build fake one-item "cycles" for the remaining modules, so we can |
| 92 | # treat them uniformly. |
| 93 | foreach my $module (@modules) { |
| 94 | unless (defined $CYCLES{$module}) { |
| 95 | my %cycle = ($module, 1); |
| 96 | $CYCLES{$module} = \%cycle; |
| 97 | } |
| 98 | } |
| 99 | |
| 100 | # Find all our unique cycles. We have to do this the hard way because |
| 101 | # we apparently can't store hash references as hash keys without making |
| 102 | # 'strict refs' sad. |
| 103 | my %seen; |
| 104 | foreach my $cycle (values %CYCLES) { |
| 105 | unless ($seen{$cycle}) { |
| 106 | $seen{$cycle} = 1; |
| 107 | push @CYCLES, $cycle; |
| 108 | } |
| 109 | } |
| 110 | } |
| 111 | |
| 112 | # Walk through our graph depth-first (keeping a trail in @path), and report |
| 113 | # any cycles we find. |
| 114 | sub find_cycles ($@) { |
| 115 | my ($module, @path) = @_; |
| 116 | if (str_in_list($module, @path)) { |
| 117 | found_cycle($module, @path); |
| 118 | } else { |
| 119 | return if defined $SEEN{$module}; |
| 120 | $SEEN{$module} = 1; |
| 121 | foreach my $dep (@{$DEPS{$module}}) { |
| 122 | find_cycles($dep, @path, $module); |
| 123 | } |
| 124 | } |
| 125 | } |
| 126 | |
| 127 | # Give a cycle, attempt to merge it with pre-existing cycle data. |
| 128 | sub found_cycle ($@) { |
| 129 | my ($module, @path) = @_; |
| 130 | |
| 131 | # Pop any modules which aren't part of our cycle. |
| 132 | while ($path[0] ne $module) { shift @path; } |
| 133 | #print join("->", @path, $module) . "\n"; |
| 134 | |
| 135 | # Collect the modules in our cycle into a hash. |
| 136 | my %cycle; |
| 137 | foreach my $item (@path) { |
| 138 | $cycle{$item} = 1; |
| 139 | if (defined $CYCLES{$item}) { |
| 140 | # Looks like we intersect with an existing cycle, so merge |
| 141 | # all those in, too. |
| 142 | foreach my $old_item (keys %{$CYCLES{$item}}) { |
| 143 | $cycle{$old_item} = 1; |
| 144 | } |
| 145 | } |
| 146 | } |
| 147 | |
| 148 | # Update our global cycle table. |
| 149 | my $cycle_ref = \%cycle; |
| 150 | foreach my $item (keys %cycle) { |
| 151 | $CYCLES{$item} = $cycle_ref; |
| 152 | } |
| 153 | #print join(":", sort keys %cycle) . "\n"; |
| 154 | } |
| 155 | |
| 156 | sub str_in_list ($@) { |
| 157 | my ($str, @list) = @_; |
| 158 | foreach my $item (@list) { |
| 159 | return 1 if ($item eq $str); |
| 160 | } |
| 161 | return 0; |
| 162 | } |