[svn:parrot] r34231 - in trunk/languages/perl6/src: classes parser

[pmichaud]

Author: pmichaud
Date: Sun Dec 21 21:50:04 2008
New Revision: 34231

Modified:
   trunk/languages/perl6/src/classes/Positional.pir
   trunk/languages/perl6/src/classes/Whatever.pir
   trunk/languages/perl6/src/parser/actions.pm

Log:
[rakudo]:  Add whatever star to list and array slices.


Modified: trunk/languages/perl6/src/classes/Positional.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Positional.pir    (original)
+++ trunk/languages/perl6/src/classes/Positional.pir    Sun Dec 21 21:50:04 2008
@@ -38,6 +38,10 @@
     $I0 = args.'elems'()
     if $I0 != 1 goto slice
     $I0 = args[0]
+    if $I0 >= 0 goto result_fetch
+    result = new 'Failure'
+    goto end
+  result_fetch:
     result = self[$I0]
     unless null result goto end
     result = new 'Failure'
@@ -48,10 +52,14 @@
   slice_loop:
     unless args goto slice_done
     $I0 = shift args
+    if $I0 >= 0 goto slice_fetch
     .local pmc elem
+    elem = new 'Failure'
+    goto slice_elem
+  slice_fetch:
     elem = self[$I0]
     unless null elem goto slice_elem
-    elem = 'undef'()
+    elem = new 'Failure'
     self[$I0] = elem
   slice_elem:
     push result, elem
@@ -62,7 +70,7 @@
 .end
 
 .namespace []
-.sub 'postcircumfix:[ ]'
+.sub 'postcircumfix:[ ]' :multi(_)
     .param pmc invocant
     .param pmc args    :slurpy
     .param pmc options :slurpy :named
@@ -77,6 +85,20 @@
     .tailcall invocant.'postcircumfix:[ ]'(args :flat, options :flat :named)
 .end
 
+
+.sub 'postcircumfix:[ ]' :multi(_, 'Sub')
+    .param pmc invocant
+    .param pmc argsblock
+    .param pmc options :slurpy :named
+    $I0 = elements invocant
+    $P0 = box $I0
+    set_hll_global ['Whatever'], '$!slice', $P0
+    .local pmc args
+    args = argsblock()
+    args = 'list'(args)
+    .tailcall 'postcircumfix:[ ]'(invocant, args :flat, options :flat :named)
+.end
+
 =back
 
 =cut

Modified: trunk/languages/perl6/src/classes/Whatever.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Whatever.pir      (original)
+++ trunk/languages/perl6/src/classes/Whatever.pir      Sun Dec 21 21:50:04 2008
@@ -26,6 +26,19 @@
     .return ($P0)
 .end
 
+.sub '' :vtable('get_integer') :method
+    $P0 = get_global '$!slice'
+    $I0 = $P0
+    .return ($I0)
+.end
+
+.sub '' :vtable('get_number') :method
+    $P0 = get_global '$!slice'
+    $N0 = $P0
+    .return ($N0)
+.end
+
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Sun Dec 21 21:50:04 2008
@@ -1560,9 +1560,8 @@
 method postcircumfix($/, $key) {
     my $past;
     if $key eq '[ ]' {
-        $past := build_call( $( $<semilist> ) );
-        $past.node($/);
-        $past.name('postcircumfix:[ ]');
+        $past := PAST::Block.new( $( $<semilist> ), :blocktype('declaration') 
);
+        $past := PAST::Op.new( $past, :name('postcircumfix:[ ]'), :node($/) );
     }
     elsif $key eq '( )' {
         $past := build_call( $( $<semilist> ) );