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

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

From:
pmichaud
Date:
January 8, 2009 15:12
Subject:
[svn:parrot] r35231 - in branches/rvar2/languages/perl6/src: builtins parser
Message ID:
20090108231243.13F0ACB9FA@x12.develooper.com
Author: pmichaud
Date: Thu Jan  8 15:12:42 2009
New Revision: 35231

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

Log:
[rakudo]:  Add more complete 'is export' handling.  S11-modules/export.t passes.


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 15:12:42 2009
@@ -366,6 +366,32 @@
 .end
 
 
+=item !capture
+
+Combine slurpy positional and slurpy named args into a list.
+Note that original order may be lost -- that's the nature
+of captures.
+
+=cut
+
+.sub '!capture'
+    .param pmc args            :slurpy
+    .param pmc options         :slurpy :named
+    unless options goto done
+    .local pmc it
+    it = iter options
+  iter_loop:
+    unless it goto done
+    $S0 = shift it
+    $P0 = options[$S0]
+    $P0 = 'infix:=>'($S0, $P0)
+    push args, $P0
+    goto iter_loop
+  done:
+    .tailcall args.'list'()
+.end
+
+
 =item !meta_create(type, name, also)
 
 Create a metaclass object for C<type> with the given C<name>.  
@@ -652,12 +678,28 @@
     .param pmc block
     .param pmc arg
 
+    .local string blockname
+    blockname = block
     .local pmc blockns, exportns
     blockns = block.'get_namespace'()
-    $P0 = split '::', 'EXPORT::ALL'
-    exportns = blockns.'make_namespace'($P0)
-    $S0 = block
-    exportns[$S0] = block
+    exportns = blockns.'make_namespace'('EXPORT')
+    if null arg goto arg_done
+    .local pmc it
+    arg = arg.'list'()
+    it = iter arg
+  arg_loop:
+    unless it goto arg_done
+    .local pmc tag, ns
+    tag = shift it
+    $I0 = isa tag, ['Perl6Pair']
+    unless $I0 goto arg_loop
+    $S0 = tag.'key'()
+    ns = exportns.'make_namespace'($S0)
+    ns[blockname] = block
+    goto arg_loop
+  arg_done:
+    ns = exportns.'make_namespace'('ALL')
+    ns[blockname] = block
 .end
 
 

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 15:12:42 2009
@@ -940,13 +940,22 @@
     make $past;
 }
 
+
 method trait_auxiliary($/) {
-    my $sym := ~$<sym>;
-    my $trait;
-    if $sym eq 'is' || $sym eq 'does' {
-        $trait := ~$<name>;
+    my $sym   := ~$<sym>;
+    my $trait := PAST::Op.new( :name('infix:,'), 'trait_auxiliary:' ~ $sym);
+    if $sym eq 'is' {
+        $trait.push( ~$<name> );
+        if $<postcircumfix> {
+            my $arg := $( $<postcircumfix>[0] );
+            $arg.name('!capture');
+            $trait.push($arg);
+        }
+    }
+    elsif $sym eq 'does' {
+        $trait.push( ~$<name> );
     }
-    make PAST::Op.new( :name('infix:,'), 'trait_auxiliary:' ~ $sym, $trait );
+    make $trait;
 }
 
 



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