On 8/22/06, Brandon Black <[EMAIL PROTECTED]> wrote:
Ok, I lied. I went back to stare at Algorithm::C3 and Class::C3, and I remembered an earlier performance hack I had tried, but never got around to cleaning up and committing and pushing out. It won't solve all your ills, but it should give another incremental performance boost for DBIC start times and its a relatively nonintrusive change that can be made Right Now. Attached are patches against the latest CPAN versions of Algorithm::C3 and Class::C3, please give them a shot (if nothing else, I'd like some testing feedback on them before committing and pushing this stuff).
-- Brandon[...] and it might not be possible to make it significantly faster without rewriting it in XS [...]
Ok, I lied. I went back to stare at Algorithm::C3 and Class::C3, and I remembered an earlier performance hack I had tried, but never got around to cleaning up and committing and pushing out. It won't solve all your ills, but it should give another incremental performance boost for DBIC start times and its a relatively nonintrusive change that can be made Right Now. Attached are patches against the latest CPAN versions of Algorithm::C3 and Class::C3, please give them a shot (if nothing else, I'd like some testing feedback on them before committing and pushing this stuff).
=== MANIFEST
==================================================================
--- MANIFEST (revision 13297)
+++ MANIFEST (local)
@@ -12,5 +12,6 @@
t/004_merge.t
t/005_order_disagreement.t
t/006_complex_merge.t
+t/007_cached_merge.t
t/pod.t
t/pod_coverage.t
=== lib/Algorithm/C3.pm
==================================================================
--- lib/Algorithm/C3.pm (revision 13297)
+++ lib/Algorithm/C3.pm (local)
@@ -9,11 +9,10 @@
our $VERSION = '0.04';
sub merge {
- my ($root, $parent_fetcher) = @_;
+ my ($root, $parent_fetcher, $cache) = @_;
+ $cache ||= {};
my @STACK; # stack for simulating recursion
- my %fcache; # cache of _fetcher results
- my %mcache; # cache of merge do-block results
my $pfetcher_is_coderef = ref($parent_fetcher) eq 'CODE';
@@ -42,13 +41,13 @@
]);
$current_root = $new_root;
- $current_parents = $fcache{$current_root} ||= [ $current_root->$parent_fetcher ];
+ $current_parents = $cache->{pfetch}->{$current_root} ||= [ $current_root->$parent_fetcher ];
$recurse_mergeout = [];
$i = 0;
next;
}
- my $mergeout = $mcache{$current_root} ||= do {
+ my $mergeout = $cache->{merge}->{$current_root} ||= do {
# This do-block is the code formerly known as the function
# that was a perl-port of the python code at
@@ -183,7 +182,7 @@
=over 4
-=item B<merge ($root, $func_to_fetch_parent)>
+=item B<merge ($root, $func_to_fetch_parent, $cache)>
This takes a C<$root> node, which can be anything really it
is up to you. Then it takes a C<$func_to_fetch_parent> which
@@ -214,6 +213,26 @@
for C<merge> to extract the parents of C<$root>. This is
needed for C3 to be able to do it's work.
+The C<$cache> parameter is an entirely optional performance
+measure, and should not change behavior.
+
+If supplied, it should be a hashref that merge can use as a
+private cache between runs to speed things up. Generally
+speaking, if you will be calling merge many times on related
+things, and the parent fetching funtion will return constant
+results given the same arguments during all of these calls,
+you can and should reuse the same shared cache hash for all
+of the calls. Example:
+
+ sub do_some_merging {
+ my %merge_cache;
+ my @foo_mro = Algorithm::C3::Merge('Foo', \&get_supers, \%merge_cache);
+ my @bar_mro = Algorithm::C3::Merge('Bar', \&get_supers, \%merge_cache);
+ my @baz_mro = Algorithm::C3::Merge('Baz', \&get_supers, \%merge_cache);
+ my @quux_mro = Algorithm::C3::Merge('Quux', \&get_supers, \%merge_cache);
+ # ...
+ }
+
=back
=head1 CODE COVERAGE
=== t/007_cached_merge.t
==================================================================
--- t/007_cached_merge.t (revision 13297)
+++ t/007_cached_merge.t (local)
@@ -0,0 +1,153 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN {
+ use_ok('Algorithm::C3');
+}
+
+=pod
+
+Just like 006_complex_merge, but with the caching turned on.
+
+This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879
+
+ --- --- ---
+Level 5 8 | A | 9 | B | A | C | (More General)
+ --- --- --- V
+ \ | / |
+ \ | / |
+ \ | / |
+ \ | / |
+ --- |
+Level 4 7 | D | |
+ --- |
+ / \ |
+ / \ |
+ --- --- |
+Level 3 4 | G | 6 | E | |
+ --- --- |
+ | | |
+ | | |
+ --- --- |
+Level 2 3 | H | 5 | F | |
+ --- --- |
+ \ / | |
+ \ / | |
+ \ | |
+ / \ | |
+ / \ | |
+ --- --- |
+Level 1 1 | J | 2 | I | |
+ --- --- |
+ \ / |
+ \ / |
+ --- v
+Level 0 0 | K | (More Specialized)
+ ---
+
+
+0123456789A
+KJIHGFEDABC
+
+=cut
+
+{
+ package Test::A;
+ sub x { 1 }
+
+ package Test::B;
+ sub x { 1 }
+
+ package Test::C;
+ sub x { 1 }
+
+ package Test::D;
+ use base qw/Test::A Test::B Test::C/;
+
+ package Test::E;
+ use base qw/Test::D/;
+
+ package Test::F;
+ use base qw/Test::E/;
+
+ package Test::G;
+ use base qw/Test::D/;
+
+ package Test::H;
+ use base qw/Test::G/;
+
+ package Test::I;
+ use base qw/Test::H Test::F/;
+
+ package Test::J;
+ use base qw/Test::F/;
+
+ package Test::K;
+ use base qw/Test::J Test::I/;
+}
+
+sub supers {
+ no strict 'refs';
+ @{$_[0] . '::ISA'};
+}
+
+my %cache;
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::A', \&supers, \%cache) ],
+ [ qw(Test::A) ],
+ '... got the right C3 merge order for Test::A');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::B', \&supers, \%cache) ],
+ [ qw(Test::B) ],
+ '... got the right C3 merge order for Test::B');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::C', \&supers, \%cache) ],
+ [ qw(Test::C) ],
+ '... got the right C3 merge order for Test::C');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::D', \&supers, \%cache) ],
+ [ qw(Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::D');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::E', \&supers, \%cache) ],
+ [ qw(Test::E Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::E');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::F', \&supers, \%cache) ],
+ [ qw(Test::F Test::E Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::F');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::G', \&supers, \%cache) ],
+ [ qw(Test::G Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::G');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::H', \&supers, \%cache) ],
+ [ qw(Test::H Test::G Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::H');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::I', \&supers, \%cache) ],
+ [ qw(Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::I');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::J', \&supers, \%cache) ],
+ [ qw(Test::J Test::F Test::E Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::J');
+
+is_deeply(
+ [ Algorithm::C3::merge('Test::K', \&supers, \%cache) ],
+ [ qw(Test::K Test::J Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ],
+ '... got the right C3 merge order for Test::K');
=== lib/Class/C3.pm
==================================================================
--- lib/Class/C3.pm (revision 13297)
+++ lib/Class/C3.pm (local)
@@ -67,15 +67,16 @@
## functions for applying C3 to classes
sub _calculate_method_dispatch_tables {
+ my %merge_cache;
foreach my $class (keys %MRO) {
- _calculate_method_dispatch_table($class);
+ _calculate_method_dispatch_table($class, \%merge_cache);
}
}
sub _calculate_method_dispatch_table {
- my $class = shift;
+ my ($class, $merge_cache) = @_;
no strict 'refs';
- my @MRO = calculateMRO($class);
+ my @MRO = calculateMRO($class, $merge_cache);
$MRO{$class} = { MRO => [EMAIL PROTECTED] };
my $has_overload_fallback = 0;
my %methods;
@@ -139,11 +140,11 @@
## functions for calculating C3 MRO
sub calculateMRO {
- my ($class) = @_;
+ my ($class, $merge_cache) = @_;
return Algorithm::C3::merge($class, sub {
no strict 'refs';
@{$_[0] . '::ISA'};
- });
+ }, $merge_cache);
}
package # hide me from PAUSE
_______________________________________________ List: [email protected] Listinfo: http://lists.rawmode.org/mailman/listinfo/catalyst Searchable archive: http://www.mail-archive.com/[email protected]/ Dev site: http://dev.catalyst.perl.org/
