11 # this function is a perl-port of the
12 # python code on this page:
13 # http://www.python.org/2.3/mro.html
16 my $class_being_merged = $seqs[0]->[0];
19 # remove all empty seqences
20 my @nonemptyseqs = (map { (@{$_} ? $_ : ()) } @seqs);
21 # return the list if we have no more no-empty sequences
22 return @res if not @nonemptyseqs;
24 my $cand; # a canidate ..
25 foreach my $seq (@nonemptyseqs) {
26 $cand = $seq->[0]; # get the head of the list
28 foreach my $sub_seq (@nonemptyseqs) {
29 # XXX - this is instead of the python "in"
30 my %in_tail = (map { $_ => 1 } @{$sub_seq}[ 1 .. $#{$sub_seq} ]);
32 # jump out as soon as we find one matching
33 # there is no reason not too. However, if
34 # we find one, then just remove the '&& last'
35 ++$nothead && last if exists $in_tail{$cand};
37 last unless $nothead; # leave the loop with our canidate ...
39 $cand = undef; # otherwise, reject it ...
41 die "Inconsistent hierarchy found while merging '$class_being_merged':\n\t" .
42 "current merge results [\n\t\t" . (join ",\n\t\t" => @res) . "\n\t]\n\t" .
43 "merging failed on '$reject'\n" if not $cand;
45 # now loop through our non-empties and pop
46 # off the head if it matches our canidate
47 foreach my $seq (@nonemptyseqs) {
48 shift @{$seq} if $seq->[0] eq $cand;
54 my ($root, $_parent_fetcher) = @_;
55 my $parent_fetcher = $_parent_fetcher;
56 unless (ref($parent_fetcher) && ref($parent_fetcher) eq 'CODE') {
57 $parent_fetcher = $root->can($_parent_fetcher) || confess "Could not find method $_parent_fetcher in $root";
61 (map { [ merge($_, $_parent_fetcher) ] } $root->$parent_fetcher()),
62 [ $parent_fetcher->($root) ],
74 Algorithm::C3 - A module for merging hierarchies using the C3 algorithm
80 # merging a classic diamond
81 # inheritence graph like this:
89 my @merged = Algorithm::C3::merge(
92 # extract the ISA array
99 print join ", " => @merged; # prints D, B, C, A
103 This module implements the C3 algorithm. I have broken this out
104 into it's own module because I found myself copying and pasting
105 it way too often for various needs. Most of the uses I have for
106 C3 revolve around class building and metamodels, but it could
107 also be used for things like dependency resolution as well since
108 it tends to do such a nice job of preserving local precendence
111 Below is a brief explanation of C3 taken from the L<Class::C3>
112 module. For more detailed information, see the L<SEE ALSO> section
117 C3 is the name of an algorithm which aims to provide a sane method
118 resolution order under multiple inheritence. It was first introduced
119 in the langauge Dylan (see links in the L<SEE ALSO> section), and
120 then later adopted as the prefered MRO (Method Resolution Order)
121 for the new-style classes in Python 2.3. Most recently it has been
122 adopted as the 'canonical' MRO for Perl 6 classes, and the default
123 MRO for Parrot objects as well.
125 =head2 How does C3 work.
127 C3 works by always preserving local precendence ordering. This
128 essentially means that no class will appear before any of it's
129 subclasses. Take the classic diamond inheritence pattern for
138 The standard Perl 5 MRO would be (D, B, A, C). The result being that
139 B<A> appears before B<C>, even though B<C> is the subclass of B<A>.
140 The C3 MRO algorithm however, produces the following MRO (D, B, C, A),
141 which does not have this same issue.
143 This example is fairly trival, for more complex examples and a deeper
144 explaination, see the links in the L<SEE ALSO> section.
150 =item B<merge ($root, $func_to_fetch_parent)>
152 This takes a C<$root> node, which can be anything really it
153 is up to you. Then it takes a C<$func_to_fetch_parent> which
154 can be either a CODE reference (see L<SYNOPSIS> above for an
155 example), or a string containing a method name to be called
156 on all the items being linearized. An example of how this
172 our @ISA = ('B', 'C');
175 print join ", " => Algorithm::C3::merge('D', 'supers');
177 The purpose of C<$func_to_fetch_parent> is to provide a way
178 for C<merge> to extract the parents of C<$root>. This is
179 needed for C3 to be able to do it's work.
185 I use B<Devel::Cover> to test the code coverage of my tests, below
186 is the B<Devel::Cover> report on this module's test suite.
188 ------------------------ ------ ------ ------ ------ ------ ------ ------
189 File stmt bran cond sub pod time total
190 ------------------------ ------ ------ ------ ------ ------ ------ ------
191 Algorithm/C3.pm 100.0 100.0 55.6 100.0 100.0 100.0 94.4
192 ------------------------ ------ ------ ------ ------ ------ ------ ------
193 Total 100.0 100.0 55.6 100.0 100.0 100.0 94.4
194 ------------------------ ------ ------ ------ ------ ------ ------ ------
198 =head2 The original Dylan paper
202 =item L<http://www.webcom.com/haahr/dylan/linearization-oopsla96.html>
206 =head2 The prototype Perl 6 Object Model uses C3
210 =item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel/>
214 =head2 Parrot now uses C3
218 =item L<http://aspn.activestate.com/ASPN/Mail/Message/perl6-internals/2746631>
220 =item L<http://use.perl.org/~autrijus/journal/25768>
224 =head2 Python 2.3 MRO related links
228 =item L<http://www.python.org/2.3/mro.html>
230 =item L<http://www.python.org/2.2.2/descrintro.html#mro>
234 =head2 C3 for TinyCLOS
238 =item L<http://www.call-with-current-continuation.org/eggs/c3.html>
244 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
246 =head1 COPYRIGHT AND LICENSE
248 Copyright 2006 by Infinity Interactive, Inc.
250 L<http://www.iinteractive.com>
252 This library is free software; you can redistribute it and/or modify
253 it under the same terms as Perl itself.