Re-implement does completely in terms of the metamodel, not relying o…

…n Parrot's underlying primitives.

src/builtins/Role.pir

@@ -145,6 +145,13 @@ Checks if the given topic does the role.
     unless it goto it_loop_end
     $P0 = shift it
     $P0 = $P0["role"]
+    $P1 = topic.'HOW'()
+    $I0 = can $P1, 'does'
+    unless $I0 goto try_parrot_does
+    $I0 = $P1.'does'(topic, $P0)
+    if $I0 == 0 goto it_loop
+    goto it_loop_end
+  try_parrot_does:
     $I0 = does topic, $P0
     if $I0 == 0 goto it_loop
   it_loop_end:

src/metamodel/ClassHOW.pir

@@ -34,6 +34,7 @@ backing store.
     addattribute $P0, '$!hides'
     addattribute $P0, '$!hidden'
     addattribute $P0, '$!composees'
+    addattribute $P0, '$!done'
 
     # Create proto-object for it.
     classhowproto = p6meta.'register'($P0)
@@ -255,36 +256,8 @@ Completes the creation of the metaclass and return a proto-object.
     .return ($P0)
   no_its_new:
 
-    # See if we have anything to compose. Also, make sure our composees
-    # all want the same composer.
-    .local pmc composees, chosen_applier, composee_it
-    composees = getattribute meta, '$!composees'
-    $I0 = elements composees
-    if $I0 == 0 goto composition_done
-    if $I0 == 1 goto one_composee
-    composee_it = iter composees
-  composee_it_loop:
-    unless composee_it goto apply_composees
-    $P0 = shift composee_it
-    if null chosen_applier goto first_composee
-    $P1 = $P0.'HOW'()
-    $P1 = $P1.'applier_for'($P0, meta)
-    $P2 = chosen_applier.'WHAT'()
-    $P3 = $P1.'WHAT'()
-    $I0 = '&infix:<===>'($P2, $P3)
-    if $I0 goto composee_it_loop
-    die 'Can not compose multiple composees that want different appliers'
-  first_composee:
-    $P1 = $P0.'HOW'()
-    chosen_applier = $P1.'applier_for'($P0, meta)
-    goto composee_it_loop
-  one_composee:
-    $P0 = composees[0]
-    $P1 = $P0.'HOW'()
-    chosen_applier = $P1.'applier_for'($P0, meta)
-  apply_composees:
-    chosen_applier.'apply'(meta, composees)
-  composition_done:
+    # Compose any composables.
+    'compose_composables'(meta)
 
     # Iterate over the attributes and compose them.
     .local pmc attr_it, attributes
@@ -343,13 +316,27 @@ Tests role membership.
     .param pmc type
 
     # Check if we have a Perl6Role - needs special handling.
+    # It will end up calling back to us, but with individual
+    # variants, 
     $I0 = isa type, 'Perl6Role'
     unless $I0 goto not_p6role
     .tailcall type.'ACCEPTS'(obj)
+
+    # Otherwise, see if the target is in our done list.
   not_p6role:
-    $I0 = does obj, type
-    .const 'Sub' $P1 = '&prefix:<?>'
-    .tailcall $P1($I0)
+    type = descalarref type
+    $P0 = getattribute self, '$!done'
+    if null $P0 goto false
+    $P0 = iter $P0
+  it_loop:
+    unless $P0 goto false
+    $P1 = shift $P0
+    eq_addr $P1, type, true
+    goto it_loop
+  false:
+    .return (0)
+  true:
+    .return (1)
 .end
 
 
@@ -632,7 +619,7 @@ Accessor for hidden property.
 .end
 
 
-=item new_class(name [, 'parent'=>parentclass] [, 'attr'=>attr] [, 'hll'=>hll])
+=item new_class(name [, 'parent'=>parentclass] [, 'attr'=>attr] [, 'hll'=>hll] [, 'does_role'=>r)
 
 Override of new_class from P6metaclass that handles attributes through the
 correct protocol.
@@ -704,9 +691,53 @@ correct protocol.
     goto iter_loop
   iter_end:
   attr_done:
+
+    $P0 = options['does_role']
+    if null $P0 goto role_done
+    self.'add_composable'(how, $P0)
+    'compose_composables'(how)
+  role_done:
+
     .tailcall self.'register'(parrotclass, 'how'=>how, options :named :flat)
 .end
 
+
+.sub 'compose_composables'
+    .param pmc meta
+
+    # See if we have anything to compose. Also, make sure our composees
+    # all want the same composer.
+    .local pmc composees, chosen_applier, composee_it, done
+    composees = getattribute meta, '$!composees'
+    $I0 = elements composees
+    if $I0 == 0 goto composition_done
+    if $I0 == 1 goto one_composee
+    composee_it = iter composees
+  composee_it_loop:
+    unless composee_it goto apply_composees
+    $P0 = shift composee_it
+    if null chosen_applier goto first_composee
+    $P1 = $P0.'HOW'()
+    $P1 = $P1.'applier_for'($P0, meta)
+    $P2 = chosen_applier.'WHAT'()
+    $P3 = $P1.'WHAT'()
+    $I0 = '&infix:<===>'($P2, $P3)
+    if $I0 goto composee_it_loop
+    die 'Can not compose multiple composees that want different appliers'
+  first_composee:
+    $P1 = $P0.'HOW'()
+    chosen_applier = $P1.'applier_for'($P0, meta)
+    goto composee_it_loop
+  one_composee:
+    $P0 = composees[0]
+    $P1 = $P0.'HOW'()
+    chosen_applier = $P1.'applier_for'($P0, meta)
+  apply_composees:
+    done = chosen_applier.'apply'(meta, composees)
+    setattribute meta, '$!done', done
+  composition_done:
+.end
+
 =back
 
 =cut

src/metamodel/RoleHOW.pir

@@ -21,7 +21,7 @@ on.
 .sub 'onload' :anon :init :load
     .local pmc p6meta, rolehowproto
     p6meta = get_hll_global ['Mu'], '$!P6META'
-    rolehowproto = p6meta.'new_class'('RoleHOW', 'parent'=>'Mu', 'attr'=>'parrotclass shortname longname protoobject $!parents $!composees $!requirements $!collisions $!attributes')
+    rolehowproto = p6meta.'new_class'('RoleHOW', 'parent'=>'Mu', 'attr'=>'parrotclass shortname longname protoobject $!parents $!composees $!requirements $!collisions $!attributes $!done')
 
     # Also want to get various methods from the ParrotBacked role, since we're
     # backed by a Parrot Class PMC and using it to store most things.
@@ -221,6 +221,28 @@ Accessor for list of attributes in the role.
 .end
 
 
+=item composees
+
+Returns all of the composees that this role has. With the :trasitive flag
+it represents all of those that have been composed in from other roles too.
+
+XXX This is non-spec ATM.
+
+=cut
+
+.sub 'composees' :method
+    .param pmc meta
+    .param pmc transitive :named('transitive') :optional
+    if null transitive goto intransitive
+    unless transitive goto intransitive
+    $P0 = getattribute meta, '$!done'
+    .return ($P0)
+  intransitive:
+    $P0 = getattribute meta, '$!composees'
+    .return ($P0)
+.end
+
+
 =item applier_for
 
 For now, we can't use a class as a composable thing. In the future we can
@@ -261,10 +283,12 @@ Completes the creation of the metaclass and return the P6role.
 
 .sub 'compose' :method
     .param pmc meta
+    .local pmc p6role
+    p6role = getattribute meta, 'parrotclass'
 
     # See if we have anything to compose. Also, make sure our composees
     # all want the same composer.
-    .local pmc composees, chosen_applier, composee_it
+    .local pmc composees, chosen_applier, composee_it, done
     composees = getattribute meta, '$!composees'
     $I0 = elements composees
     if $I0 == 0 goto composition_done
@@ -290,12 +314,15 @@ Completes the creation of the metaclass and return the P6role.
     $P1 = $P0.'HOW'()
     chosen_applier = $P1.'applier_for'($P0, meta)
   apply_composees:
-    chosen_applier.'apply'(meta, composees)
+    done = chosen_applier.'apply'(meta, composees)
   composition_done:
+    unless null done goto done_done
+    done = root_new ['parrot';'ResizablePMCArray']
+  done_done:
+    done.'unshift'(p6role)
+    setattribute meta, '$!done', done
 
     # Associate the metaclass with the p6role.
-    .local pmc p6role
-    p6role = getattribute meta, 'parrotclass'
     setprop p6role, 'how', meta
     setattribute meta, 'protoobject', p6role
     .return (p6role)

src/metamodel/RoleToClassApplier.nqp

@@ -89,6 +89,10 @@ method apply($target, @composees) {
     for @parents {
         $target.add_parent($target, $_);
     }
+
+    # The full list of done roles is just the list of the one role we have
+    # composed in.
+    return RoleHOW.composees($to_compose_meta, :transitive(1));
 }
 
 =begin

src/metamodel/RoleToRoleApplier.nqp

@@ -82,6 +82,7 @@ method apply($target, @composees) {
     }
 
     # Now do the other bits.
+    my @all_composees;
     for @composees {
         my $how := $_.HOW;
 
@@ -117,7 +118,15 @@ method apply($target, @composees) {
         for @parents {
             $target.add_parent($target, $_);
         }
+
+        # Build up full list.
+        my @composees := $how.composees($how, :transitive(1));
+        for @composees {
+            @all_composees.push($_);
+        }
     }
+
+    return @all_composees;
 }
 
 =begin