This gets us creating the metaclass right at the start of class creat…

…ion and operating on it. We dispatch traits on it also, which many of the fixes in here are helping towards. We also make mentions of ClassHOW work more properly, by having it registered, so now it's a bit less special. For now, there's more mess, but this is mostly an enabling refactor for more cleanups.

src/builtins/guts.pir

@@ -516,16 +516,19 @@ is composed (see C<!meta_compose> below).
     .return ($P0)
 
   class:
-    .local pmc metaclass, ns
+    .local pmc parrotclass, metaclass, ns
     ns = get_hll_namespace nsarray
     if also goto is_also
-    metaclass = newclass ns
+    parrotclass = newclass ns
     $P0 = box type
-    setprop metaclass, 'pkgtype', $P0
-    '!set_resolves_list'(metaclass)
+    setprop parrotclass, 'pkgtype', $P0
+    '!set_resolves_list'(parrotclass)
+    metaclass = new ['ClassHOW']
+    setattribute metaclass, 'parrotclass', parrotclass
     .return (metaclass)
   is_also:
-    metaclass = get_class ns
+    parrotclass = get_class ns
+    metaclass = getprop 'metaclass', parrotclass
     .return (metaclass)
 
   role:
@@ -570,47 +573,46 @@ and creating the protoobjects.
 
 =cut
 
-.sub '!meta_compose' :multi(['Class'])
+.sub '!meta_compose' :multi(['P6metaclass'])
     .param pmc metaclass
     .local pmc p6meta
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
 
+    # Extract the parrotclass form the metaclass.
+    .local pmc parrotclass
+    parrotclass = getattribute metaclass, 'parrotclass'
+
     # Parrot handles composing methods into roles, but we need to handle the
     # attribute composition ourselves.
     .local pmc roles, roles_it
-    roles = getprop '@!roles', metaclass
+    roles = getprop '@!roles', parrotclass
     if null roles goto roles_it_loop_end
     roles = '!get_flattened_roles_list'(roles)
     roles_it = iter roles
   roles_it_loop:
     unless roles_it goto roles_it_loop_end
     $P0 = shift roles_it
-    $I0 = does metaclass, $P0
+    $I0 = does parrotclass, $P0
     if $I0 goto roles_it_loop
-    metaclass.'add_role'($P0)
-    '!compose_role_attributes'(metaclass, $P0)
+    parrotclass.'add_role'($P0)
+    '!compose_role_attributes'(parrotclass, $P0)
     goto roles_it_loop
   roles_it_loop_end:
 
-    # Create a HOW of the right type.
-    .local pmc how
-    how = new ['ClassHOW']
-    setattribute how, 'parrotclass', metaclass
-
     # Create proto-object with default parent being Any or Grammar, unless
     # there already is a parent.
-    $P0 = metaclass.'parents'()
+    $P0 = parrotclass.'parents'()
     $I0 = elements $P0
     if $I0 goto register_parent_set
     $S0 = 'Any'
-    $P0 = getprop 'pkgtype', metaclass
+    $P0 = getprop 'pkgtype', parrotclass
     if null $P0 goto no_pkgtype
     if $P0 != 'grammar' goto register
     $S0 = 'Grammar'
   register:
-    .tailcall p6meta.'register'(metaclass, 'parent'=>$S0, 'how'=>how)
+    .tailcall p6meta.'register'(parrotclass, 'parent'=>$S0, 'how'=>metaclass)
   register_parent_set:
-    .tailcall p6meta.'register'(metaclass, 'how'=>how)
+    .tailcall p6meta.'register'(parrotclass, 'how'=>metaclass)
   no_pkgtype:
 .end
 
@@ -705,6 +707,13 @@ and C<type>.
     substr name, offset, 1, '!'
   twigil_done:
 
+    # In the future, we'll want to have just called metaclass.add_attribute(...)
+    # here and let it handle all of this, but we ain't quite ready for that yet.
+    $I0 = isa metaclass, 'P6metaclass'
+    unless $I0 goto got_parrot_class
+    metaclass = getattribute metaclass, 'parrotclass'
+  got_parrot_class:
+
     $P0 = metaclass.'attributes'()
     $I0 = exists $P0[name]
     if $I0 goto attr_exists

src/classes/ClassHOW.pir

@@ -19,15 +19,31 @@ This class subclasses P6metaclass to give Perl 6 specific meta-class behaviors.
     # We need to specially construct our subclass of p6metaclass. We also
     # make it subclass Object.
     $P0 = newclass 'ClassHOW'
-    $P1 = get_root_global ['parrot'], 'P6metaclass'
-    $P1 = typeof $P1
+    $P1 = get_class 'P6metaclass'
     addparent $P0, $P1
     $P1 = get_hll_global 'Object'
     $P1 = p6meta.'get_parrotclass'($P1)
     addparent $P0, $P1
 
-    # Now rebless p6meta - which means Object's metaclass - into it.
-    rebless_subclass p6meta, $P0
+    # Create proto-object for it.
+    classhowproto = p6meta.'register'($P0)
+
+    # Transform Object's metaclass to be of the right type.
+    $P0 = new ['ClassHOW']
+    $P1 = getattribute p6meta, 'parrotclass'
+    setattribute $P0, 'parrotclass', $P1
+    $P1 = getattribute p6meta, 'protoobject'
+    setattribute $P0, 'protoobject', $P1
+    $P1 = getattribute p6meta, 'longname'
+    setattribute $P0, 'longname', $P1
+    $P1 = getattribute p6meta, 'shortname'
+    setattribute $P0, 'shortname', $P1
+    set_hll_global ['Perl6Object'], '$!P6META', $P0
+    $P1 = getattribute p6meta, 'parrotclass'
+    setprop $P1, 'metaclass', $P0
+    $P1 = get_hll_global 'Object'
+    $P1 = typeof $P1
+    setprop $P1, 'metaclass', $P0
 .end
 
 =head2 Methods on ClassHOW
@@ -338,6 +354,23 @@ Gets a list of roles done by the class of this object.
     .return (result_list)
 .end
 
+
+=item WHAT
+
+Overridden since WHAT inherited from P6metaclass doesn't quite work out.
+XXX Work out exactly why.
+
+=cut
+
+.sub 'WHAT' :method
+    $P0 = getattribute self, 'protoobject'
+    if null $P0 goto proto_of_how
+    .return ($P0)
+  proto_of_how:
+    $P0 = self.'HOW'()
+    .tailcall $P0.'WHAT'()
+.end
+
 =back
 
 =cut

src/setting/traits.pm

@@ -17,6 +17,12 @@ multi trait_mod:<is>(Object $child, Object $parent) {
     parent = parent.'!pun'()
   have_class:
 
+    # Is child a metaclass?
+    $I0 = isa child, 'ClassHOW'
+    unless $I0 goto have_parrotclass
+    child = getattribute child, 'parrotclass'
+  have_parrotclass:
+
     # Now the the real parrot class and add parent.
     .local pmc p6meta
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
@@ -94,12 +100,14 @@ multi trait_mod:<does>(Object $class is rw, Object $role) {
     $I0 = isa metaclass, 'Class'
     if $I0 goto is_class
     $I0 = isa metaclass, 'P6role'
-    if $I0 goto is_class
+    if $I0 goto is_role
     $I0 = isa metaclass, 'Perl6Role'
-    if $I0 goto is_class
+    if $I0 goto is_role
     'infix:does'(metaclass, role)
     .return ()
   is_class:
+    metaclass = getattribute metaclass, 'parrotclass'
+  is_role:
 
     # If it's an un-selected role, do so.
     $I0 = isa role, 'P6role'