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

[svn:parrot] r35225 - in branches/rvar2/languages/perl6/src: builtins parser

From:
pmichaud
Date:
January 8, 2009 14:10
Subject:
[svn:parrot] r35225 - in branches/rvar2/languages/perl6/src: builtins parser
Message ID:
20090108221028.12E11CB9F9@x12.develooper.com
Author: pmichaud
Date: Thu Jan  8 14:10:27 2009
New Revision: 35225

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

Log:
[rakudo]:  Some basic trait handling for subs.
I'll probably want to refactor this (to avoid the code
duplication) but this works for now.


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	Thu Jan  8 14:10:27 2009
@@ -384,11 +384,17 @@
     $P0 = compreg 'Perl6'
     nsarray = $P0.'parse_name'(name)
 
+    if type == 'package' goto package
+    if type == 'module' goto package
     if type == 'class' goto class
     if type == 'grammar' goto class
     if type == 'role' goto role
     'die'("Unsupported package declarator ", type)
 
+  package:
+    $P0 = get_hll_namespace nsarray
+    .return ($P0)
+
   class:
     .local pmc metaclass, ns
     ns = get_hll_namespace nsarray
@@ -451,14 +457,15 @@
 .end
 
 
-=item !meta_compose(Role role)
+=item !meta_compose()
+
+Default meta composer -- does nothing.
 
-Compose the role.
 
 =cut
 
-.sub '!meta_compose' :multi(['Role'])
-    .param pmc role
+.sub '!meta_compose' :multi()
+    .param pmc metaclass
     # Currently, nothing to do.
 .end
 
@@ -596,6 +603,47 @@
 .end
 
 
+=item !sub_trait(sub, type, trait, arg?)
+
+=cut
+
+.sub '!sub_trait'
+    .param pmc block
+    .param string type
+    .param string trait
+    .param pmc arg             :optional
+    .param int has_arg         :opt_flag
+
+    if has_arg goto have_arg
+    null arg
+  have_arg:
+
+    $S0 = concat '!sub_trait_', trait
+    $P0 = find_name $S0
+    if null $P0 goto done
+    $P0(trait, block, arg)
+  done:
+.end
+
+
+=item !sub_trait_export(trait, block, arg)
+
+=cut
+
+.sub '!sub_trait_export'
+    .param string trait
+    .param pmc block
+    .param pmc arg
+
+    .local pmc blockns, exportns
+    blockns = block.'get_namespace'()
+    $P0 = split '::', 'EXPORT::ALL'
+    exportns = blockns.'make_namespace'($P0)
+    $S0 = block
+    exportns[$S0] = block
+.end
+
+
 =item !compose_role_attributes(class, role)
 
 Helper method to compose the attributes of a role into a class.

Modified: branches/rvar2/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rvar2/languages/perl6/src/parser/actions.pm	Thu Jan  8 14:10:27 2009
@@ -859,45 +859,73 @@
 
 
 method routine_def($/) {
-    my $past := $( $<block> );
-    $past.blocktype('declaration');
+    my $block := $( $<block> );
+    $block.blocktype('declaration');
     if $<deflongname> {
         my $name := ~$<deflongname>[0];
-        $past.name( $name );
+        $block.name( $name );
         our @?BLOCK;
         @?BLOCK[0].symbol( $name, :scope('package') );
     }
-    $past.control('return_pir');
-    block_signature($past);
-    make $past;
+    $block.control('return_pir');
+    block_signature($block);
+
+    if $<trait> {
+        my $loadinit := $block.loadinit();
+        my $blockreg := PAST::Var.new( :name('block'), :scope('register') );
+        for @($<trait>) {
+            #  Trait nodes come in as PAST::Op( :name('list') ).
+            #  We just modify them to call !sub_trait and add
+            #  'block' as the first argument.
+            my $trait := $( $_ );
+            $trait.name('!sub_trait');
+            $trait.unshift($blockreg);
+            $loadinit.push($trait);
+        }
+    }
+    make $block;
 }
 
 
 method method_def($/) {
-    my $past := $( $<block> );
-    $past.blocktype('method');
+    my $block := $( $<block> );
+    $block.blocktype('method');
 
     if $<longname> {
-        $past.name( ~$<longname> );
+        $block.name( ~$<longname> );
     }
 
     # Add lexical 'self'.
-    $past[0].unshift(
+    $block[0].unshift(
         PAST::Var.new( :name('self'), :scope('lexical'), :isdecl(1),
             :viviself( PAST::Var.new( :name('self'), :scope('register' ) ) )
         )
     );
 
+    $block.control('return_pir');
+    block_signature($block);
     # Ensure there's an invocant in the signature.
-    block_signature($past);
-    $past.loadinit().push(PAST::Op.new(
+    $block.loadinit().push(PAST::Op.new(
         :pasttype('callmethod'),
         :name('!add_implicit_self'),
         PAST::Var.new( :name('signature'), :scope('register') )
     ));
 
-    $past.control('return_pir');
-    make $past;
+    if $<trait> {
+        my $loadinit := $block.loadinit();
+        my $blockreg := PAST::Var.new( :name('block'), :scope('register') );
+        for @($<trait>) {
+            #  Trait nodes come in as PAST::Op( :name('list') ).
+            #  We just modify them to call !sub_trait and add
+            #  'block' as the first argument.
+            my $trait := $( $_ );
+            $trait.name('!sub_trait');
+            $trait.unshift($blockreg);
+            $loadinit.push($trait);
+        }
+    }
+
+    make $block;
 }
 
 



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