port C3 linearization from nqp

Author: moritz

lib/Perl6/TypeGraph.pm

@@ -5,6 +5,55 @@ class Perl6::TypeGraph {
         has @.super;
         has @.roles;
         has $.packagetype is rw = 'class';
+
+        has @.mro;
+        method mro(Type:D:) {
+            return @!mro if @!mro;
+            if @.super == 1 {
+                @!mro = @.super[0].mro;
+            } elsif @.super > 1 {
+                my @merge_list = @.super.map: *.mro.item;
+                @!mro = self.c3_merge(@merge_list);
+            }
+            @!mro.unshift: self;
+        }
+
+        method c3_merge(@merge_list) {
+            my @result;
+            my $accepted;
+            my $something_accepted = 0;
+            my $cand_count = 0;
+            for @merge_list -> @cand_list {
+                next unless @cand_list;
+                my $rejected = 0;
+                my $cand_class = @cand_list[0];
+                $cand_count++;
+                for @merge_list {
+                    next if $_ === @cand_list;
+                    for 1..+$_ -> $cur_pos {
+                        if $_[$cur_pos] === $cand_class {
+                            $rejected = 1;
+                            last;
+                        }
+                    }
+                }
+                unless $rejected {
+                    $accepted = $cand_class;
+                    $something_accepted = 1;
+                    last;
+                }
+            }
+            return () unless $cand_count;
+            unless $something_accepted {
+                die("Could not build C3 linearization for {self}: ambiguous hierarchy");
+            }
+            for @merge_list.keys -> $i {
+                @merge_list[$i] = [@merge_list[$i].grep: { $_ ne $accepted }] ;
+            }
+            @result = self.c3_merge(@merge_list);
+            @result.unshift: $accepted;
+            @result;
+        }
     }
     my grammar Decl {
         token ident      { <.alpha> \w*                }

t/typegraph.t

@@ -10,4 +10,6 @@ ok $t.types<Array>.super.any eq 'List',
     'Array has List as a superclass';
 ok $t.types<List>.roles.any eq 'Positional',
     'List does positional';
+is $t.types<Str>.mro, 'Str Cool Any Mu', 'Str mro';
+is $t.types<Match>.mro, 'Match Capture Cool Any Mu', 'Match mro';
 done;