develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35178 - branches/rvar2/languages/perl6/src/builtins

From:
jonathan
Date:
January 7, 2009 14:21
Subject:
[svn:parrot] r35178 - branches/rvar2/languages/perl6/src/builtins
Message ID:
20090107222115.DCCF0CB9F9@x12.develooper.com
Author: jonathan
Date: Wed Jan  7 14:21:15 2009
New Revision: 35178

Modified:
   branches/rvar2/languages/perl6/src/builtins/guts.pir

Log:
[rakudo] Mostly fix composition of attributes from roles (case where slot can be shared because of compatible types still broken).

Modified: branches/rvar2/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/guts.pir	(original)
+++ branches/rvar2/languages/perl6/src/builtins/guts.pir	Wed Jan  7 14:21:15 2009
@@ -425,6 +425,19 @@
     .local pmc p6meta
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
 
+    # Parrot handles composing methods into roles, but we need to handle the
+    # attribute composition ourselves.
+    .local pmc roles, roles_it
+    roles = inspect metaclass, 'roles'
+    roles_it = iter roles
+  roles_it_loop:
+    unless roles_it goto roles_it_loop_end
+    $P0 = shift roles_it
+    '!compose_role_attributes'(metaclass, $P0)
+    goto roles_it_loop
+  roles_it_loop_end:
+
+    # Create proto-object with default parent being Any.
     p6meta.'register'(metaclass, 'parent'=>'Any')
 .end
 
@@ -574,6 +587,60 @@
 .end
 
 
+=item !compose_role_attributes(class, role)
+
+Helper method to compose the attributes of a role into a class.
+
+=cut
+
+.sub '!compose_role_attributes'
+    .param pmc class
+    .param pmc role
+
+    .local pmc role_attrs, class_attrs, ra_iter
+    .local string cur_attr
+    role_attrs = inspect role, "attributes"
+    class_attrs = inspect class, "attributes"
+    ra_iter = iter role_attrs
+  ra_iter_loop:
+    unless ra_iter goto ra_iter_loop_end
+    cur_attr = shift ra_iter
+
+    # Check that this attribute doesn't conflict with one already in the class.
+    $I0 = exists class_attrs[cur_attr]
+    unless $I0 goto no_conflict
+
+    # We have a name conflict. Let's compare the types. If they match, then we
+    # can merge the attributes.
+    .local pmc class_attr_type, role_attr_type
+    $P0 = class_attrs[cur_attr]
+    if null $P0 goto conflict
+    class_attr_type = $P0['type']
+    if null class_attr_type goto conflict
+    $P0 = role_attrs[cur_attr]
+    if null $P0 goto conflict
+    role_attr_type = $P0['type']
+    if null role_attr_type goto conflict
+    $I0 = '!SAMETYPE_EXACT'(class_attr_type, role_attr_type)
+    if $I0 goto merge
+
+  conflict:
+    $S0 = "Conflict of attribute '"
+    $S0 = concat cur_attr
+    $S0 = concat "' in composition of role '"
+    $S1 = role
+    $S0 = concat $S1
+    $S0 = concat "'"
+    'die'($S0)
+
+  no_conflict:
+    addattribute class, cur_attr
+  merge:
+    goto ra_iter_loop
+  ra_iter_loop_end:
+.end
+
+
 =item !keyword_class(name)
 
 Internal helper method to create a class.



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About