Get class inheritance working.

src/metamodel/how/NQPClassHOW.pm

@@ -66,10 +66,12 @@ knowhow NQPClassHOW {
         if $!composed {
             pir::die("NQPClassHOW does not support adding parents after being composed.");
         }
-        if self.isa($parent) {
-            pir::die("Can not add the same parent class twice");
+        for @!parents {
+            if $_ =:= $parent {
+                pir::die("Already have " ~ $parent ~ " as a parent class.");
+            }
         }
-        @!parents.push($parent);
+        @!parents[+@!parents] := $parent;
     }
 
     method compose($obj) {
@@ -78,15 +80,102 @@ knowhow NQPClassHOW {
         # Some things we only do if we weren't already composed once, like building
         # the MRO.
         unless $!composed {
-            my @mro;
-            @mro.push($obj); # XXX Needs doing properly.
-            @!mro := @mro; 
+            @!mro := compute_c3_mro($obj);
             $!composed := 1;
         }
 
         $obj
     }
 
+    # Computes C3 MRO.
+    sub compute_c3_mro($class) {
+        my @immediate_parents := $class.HOW.parents($class, :local);
+
+        # Provided we have immediate parents...
+        my @result;
+        if +@immediate_parents {
+            # Build merge list of lineraizations of all our parents, add
+            # immediate parents and merge.
+            my @merge_list;
+            for @immediate_parents {
+                @merge_list.push(compute_c3_mro($_));
+            }
+            @merge_list.push(@immediate_parents);
+            @result := c3_merge(@merge_list);
+        }
+
+        # Put this class on the start of the list, and we're done.
+        @result.unshift($class);
+        return @result;
+    }
+
+    # C3 merge routine.
+    sub c3_merge(@merge_list) {
+        my @result;
+        my $accepted;
+        my $something_accepted := 0;
+        my $cand_count := 0;
+
+        # Try to find something appropriate to add to the MRO.
+        for @merge_list {
+            my @cand_list := $_;
+            if +@cand_list {
+                my $rejected := 0;
+                my $cand_class := @cand_list[0];
+                $cand_count := $cand_count + 1;
+                for @merge_list {
+                    # Skip current list.
+                    unless $_ =:= @cand_list {
+                        # Is current candidate in the tail? If so, reject.
+                        my $cur_pos := 1;
+                        while $cur_pos <= +$_ {
+                            if $_[$cur_pos] =:= $cand_class {
+                                $rejected := 1;
+                            }
+                            $cur_pos := $cur_pos + 1;
+                        }
+                    }
+
+                    # If we didn't reject it, this candidate will do.
+                    unless $rejected {
+                        $accepted := $cand_class;
+                        $something_accepted := 1;
+                        last;
+                    }
+                }
+            }
+        }
+
+        # If we never found any candidates, return an empty list.
+        if $cand_count == 0 {
+            return @result;
+        }
+
+        # If we didn't find anything to accept, error.
+        unless $something_accepted {
+            pir::die("Could not build C3 linearization: ambiguous hierarchy");
+        }
+
+        # Otherwise, remove what was accepted from the merge lists.
+        my $i := 0;
+        while $i < +@merge_list {
+            my @new_list;
+            for @merge_list[$i] {
+                unless $_ =:= $accepted {
+                    @new_list.push($_);
+                }
+            }
+            @merge_list[$i] := @new_list;
+            $i := $i + 1;
+        }
+
+        # Need to merge what remains of the list, then put what was accepted on
+        # the start of the list, and we're done.
+        @result := c3_merge(@merge_list);
+        @result.unshift($accepted);
+        return @result;
+    }
+
     ##
     ## Introspecty
     ##
@@ -148,7 +237,7 @@ knowhow NQPClassHOW {
 
     method can($obj, $name) {
         for @!mro {
-            my %meths := $obj.HOW.method_table($obj);
+            my %meths := $_.HOW.method_table($obj);
             my $can := %meths{$name};
             if pir::defined($can) {
                 return $can;