develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33954 - in branches/rakudoreg/languages/perl6: config/makefiles docs src/builtins src/classes src/parser t tools

From:
jonathan
Date:
December 16, 2008 08:16
Subject:
[svn:parrot] r33954 - in branches/rakudoreg/languages/perl6: config/makefiles docs src/builtins src/classes src/parser t tools
Message ID:
20081216161547.5EEA8CBA12@x12.develooper.com
Author: jonathan
Date: Tue Dec 16 08:15:37 2008
New Revision: 33954

Added:
   branches/rakudoreg/languages/perl6/src/classes/Associative.pir
      - copied unchanged from r33953, /trunk/languages/perl6/src/classes/Associative.pir
Modified:
   branches/rakudoreg/languages/perl6/config/makefiles/root.in
   branches/rakudoreg/languages/perl6/docs/spectest-progress.csv
   branches/rakudoreg/languages/perl6/src/builtins/any-list.pir
   branches/rakudoreg/languages/perl6/src/builtins/assign.pir
   branches/rakudoreg/languages/perl6/src/builtins/control.pir
   branches/rakudoreg/languages/perl6/src/builtins/enums.pir
   branches/rakudoreg/languages/perl6/src/builtins/guts.pir
   branches/rakudoreg/languages/perl6/src/builtins/io.pir
   branches/rakudoreg/languages/perl6/src/classes/Array.pir
   branches/rakudoreg/languages/perl6/src/classes/Capture.pir
   branches/rakudoreg/languages/perl6/src/classes/Failure.pir
   branches/rakudoreg/languages/perl6/src/classes/Hash.pir
   branches/rakudoreg/languages/perl6/src/classes/IO.pir
   branches/rakudoreg/languages/perl6/src/classes/List.pir
   branches/rakudoreg/languages/perl6/src/classes/Mapping.pir
   branches/rakudoreg/languages/perl6/src/classes/Nil.pir
   branches/rakudoreg/languages/perl6/src/classes/Object.pir
   branches/rakudoreg/languages/perl6/src/classes/Positional.pir
   branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir
   branches/rakudoreg/languages/perl6/src/classes/Range.pir
   branches/rakudoreg/languages/perl6/src/parser/actions.pm
   branches/rakudoreg/languages/perl6/src/parser/grammar.pg
   branches/rakudoreg/languages/perl6/t/spectest.data
   branches/rakudoreg/languages/perl6/tools/test_summary.pl

Log:
[rakudo] Sync type reg branch with latest in trunk.

Modified: branches/rakudoreg/languages/perl6/config/makefiles/root.in
==============================================================================
--- branches/rakudoreg/languages/perl6/config/makefiles/root.in	(original)
+++ branches/rakudoreg/languages/perl6/config/makefiles/root.in	Tue Dec 16 08:15:37 2008
@@ -54,6 +54,7 @@
   src/classes/Abstraction.pir \
   src/classes/Protoobject.pir \
   src/classes/Positional.pir \
+  src/classes/Associative.pir \
   src/classes/Any.pir \
   src/classes/Bool.pir \
   src/classes/Str.pir \

Modified: branches/rakudoreg/languages/perl6/docs/spectest-progress.csv
==============================================================================
--- branches/rakudoreg/languages/perl6/docs/spectest-progress.csv	(original)
+++ branches/rakudoreg/languages/perl6/docs/spectest-progress.csv	Tue Dec 16 08:15:37 2008
@@ -204,3 +204,7 @@
 "2008-12-10 00:00",33741,4884,0,350,1572,6806,9358,235
 "2008-12-11 00:00",33793,4916,0,350,1561,6827,9325,235
 "2008-12-12 00:00",33823,5004,1,401,1489,6895,9356,240
+"2008-12-13 00:00",33823,5005,0,410,1480,6895,9356,240
+"2008-12-14 00:00",33844,5005,0,410,1480,6895,9356,240
+"2008-12-15 00:00",33898,5101,0,383,1485,6969,9435,249
+"2008-12-16 00:00",33949,5139,0,357,1473,6969,9435,249

Modified: branches/rakudoreg/languages/perl6/src/builtins/any-list.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/any-list.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/any-list.pir	Tue Dec 16 08:15:37 2008
@@ -21,7 +21,7 @@
 .namespace ['Any']
 .sub 'onload' :anon :init :load
     $P0 = get_hll_namespace ['Any']
-    '!EXPORT'('abs', 'from'=>$P0)
+    '!EXPORT'('end', 'from'=>$P0)
 .end
 
 
@@ -367,7 +367,7 @@
     $I0 = 'infix:cmp'($P0, $P1)
     .return ($I0)
 .end
-    
+
 =back
 
 =cut

Modified: branches/rakudoreg/languages/perl6/src/builtins/assign.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/assign.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/assign.pir	Tue Dec 16 08:15:37 2008
@@ -16,18 +16,7 @@
     .param pmc cont
     .param pmc source
 
-    $I0 = isa source, 'ObjectRef'
-    if $I0 goto have_source
-    $I0 = can source, 'Scalar'
-    if $I0 goto can_scalar
-    ##  source comes from outside Rakudo's type system
-    $I0 = does source, 'scalar'
-    if $I0 goto have_source
-    source = new 'ObjectRef', source
-    goto have_source
-  can_scalar:
-    source = source.'Scalar'()
-  have_source:
+    source = 'Scalar'(source)
     .local pmc ro, type
     getprop ro, 'readonly', cont
     if null ro goto ro_ok
@@ -48,6 +37,7 @@
     .return (cont)
 .end
 
+
 .sub 'infix:=' :multi(['Perl6Array'], _)
     .param pmc cont
     .param pmc source
@@ -59,22 +49,7 @@
     .tailcall 'infix:='(cont, source)
 
   cont_array:
-    .local pmc list, it, array
-    ## empty the array
-    array = new 'ResizablePMCArray'
-    source = 'list'(source)
-    it = iter source
-  array_loop:
-    unless it goto array_done
-    $P0 = shift it
-    $P0 = $P0.'Scalar'()
-    $P0 = clone $P0
-    push array, $P0
-    goto array_loop
-  array_done:
-    $I0 = elements cont
-    splice cont, array, 0, $I0
-    .return (cont)
+    .tailcall cont.'!STORE'(source)
 .end
 
 
@@ -89,9 +64,7 @@
     .tailcall 'infix:='(cont, source)
 
   cont_hash:
-    $P0 = source.'hash'()
-    copy cont, $P0
-    .return (cont)
+    .tailcall cont.'!STORE'(source)
 .end
 
 
@@ -146,12 +119,15 @@
     $I0 = isa cont, 'Perl6Hash'
     if $I0 goto assign_hash
   assign_scalar:
+    if slist goto have_slist
+    slist = new 'Nil'
+  have_slist:
     $P0 = shift slist
     'infix:='(cont, $P0)
     goto assign_loop
   assign_array:
   assign_hash:
-    'infix:='(cont, slist)
+    cont.'!STORE'(slist)
     slist = new 'Nil'
     goto assign_loop
   assign_done:

Modified: branches/rakudoreg/languages/perl6/src/builtins/control.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/control.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/control.pir	Tue Dec 16 08:15:37 2008
@@ -31,7 +31,7 @@
     .param int has_value       :opt_flag
 
     if has_value goto have_value
-    value = 'list'()
+    value = new 'Nil'
   have_value:
     $P0         = new 'Exception'
     $P0['type'] = .CONTROL_RETURN
@@ -126,6 +126,27 @@
     throw e
 .end
 
+.sub 'continue'
+    .local pmc e
+    e = new 'Exception'
+    e['severity'] = .EXCEPT_NORMAL
+    e['type'] = .CONTROL_CONTINUE
+    throw e
+.end
+
+.sub 'break'
+    .param pmc arg :optional
+    .param int has_arg :opt_flag
+    .local pmc e
+    e = new 'Exception'
+    e['severity'] = .EXCEPT_NORMAL
+    e['type'] = .CONTROL_BREAK
+    unless has_arg, no_arg
+    e['payload'] = arg
+  no_arg:
+    throw e
+.end
+
 =item term:...
 
 =cut
@@ -297,13 +318,22 @@
 
 .sub 'warn'
     .param pmc list            :slurpy
-    .local pmc it
+    .local pmc ex
     .local string message
 
     message = list.'join'('')
     if message > '' goto have_message
     message = "Warning!  Something's wrong\n"
   have_message:
+    ## count_eh is broken
+    # $I0 = count_eh
+    # eq $I0, 0, no_eh
+    ex = new 'Exception'
+    ex['severity'] = .EXCEPT_WARNING
+    ex['message'] = message
+    throw ex
+    .return ()
+  no_eh:
     printerr message
     .return ()
 .end

Modified: branches/rakudoreg/languages/perl6/src/builtins/enums.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/enums.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/enums.pir	Tue Dec 16 08:15:37 2008
@@ -79,7 +79,7 @@
     $P48 = "prefix:~"($P47)
     .return ($P48)
 .end
-.sub "bool_class_number" :method :subid("26")
+.sub "bool_class_number" :method
     getattribute $P52, self, "$!bool"
     $P53 = "prefix:+"($P52)
     .return ($P53)

Modified: branches/rakudoreg/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/guts.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/guts.pir	Tue Dec 16 08:15:37 2008
@@ -572,16 +572,8 @@
     WHENCE = getprop '%!WHENCE', $P0
     if null WHENCE goto no_whence
 
-    # Attach the WHENCE property.
-    .local pmc props
-    props = getattribute proto, '%!properties'
-    unless null props goto have_props
-    props = new 'Hash'
-  have_props:
-    props['WHENCE'] = WHENCE
-    setattribute proto, '%!properties', props
+    setprop proto, '%!WHENCE', WHENCE
   no_whence:
-
     .return (proto)
 .end
 

Modified: branches/rakudoreg/languages/perl6/src/builtins/io.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/io.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/io.pir	Tue Dec 16 08:15:37 2008
@@ -19,8 +19,11 @@
     it = iter args
   iter_loop:
     unless it goto iter_end
-    $S0 = shift it
-    print $S0
+    $P0 = shift it
+    unless null $P0 goto iter_nonull
+    $P0 = new 'Failure'
+  iter_nonull:
+    print $P0
     goto iter_loop
   iter_end:
     .return (1)

Modified: branches/rakudoreg/languages/perl6/src/classes/Array.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Array.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Array.pir	Tue Dec 16 08:15:37 2008
@@ -100,7 +100,7 @@
 =cut
 
 .namespace ['Perl6Array']
-.sub 'list' :method
+.sub '' :method('list')
     .tailcall self.'values'()
 .end
 
@@ -200,6 +200,7 @@
     .tailcall values.'Scalar'()
 .end
 
+
 =back
 
 =head2 Coercion methods
@@ -214,6 +215,53 @@
     .return (self)
 .end
 
+
+=back
+
+=head2 Private Methods
+
+=over
+
+=item !flatten()
+
+Return self, as Arrays are already flattened.
+
+=cut
+
+.namespace ['Perl6Array']
+.sub '!flatten' :method
+    .return (self)
+.end
+
+=item !STORE()
+
+Store things into an Array (e.g., upon assignment)
+
+=cut
+
+.namespace ['Perl6Array']
+.sub '!STORE' :method
+    .param pmc source
+    .local pmc array, it
+    ## we create a new array here instead of emptying self in case
+    ## the source argument contains self or elements of self.
+    array = new 'ResizablePMCArray'
+    source = 'list'(source)
+    it = iter source
+  array_loop:
+    unless it goto array_done
+    $P0 = shift it
+    $P0 = 'Scalar'($P0)
+    $P0 = clone $P0
+    push array, $P0
+    goto array_loop
+  array_done:
+    $I0 = elements self
+    splice self, array, 0, $I0
+    .return (self)
+.end
+
+
 =back
 
 =cut

Modified: branches/rakudoreg/languages/perl6/src/classes/Capture.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Capture.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Capture.pir	Tue Dec 16 08:15:37 2008
@@ -16,7 +16,7 @@
     load_bytecode 'Parrot/Capture_PIR.pbc'
     .local pmc p6meta, captureproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    captureproto = p6meta.'new_class'('Perl6Capture', 'parent'=>'Capture_PIR Any', 'name'=>'Capture')
+    captureproto = p6meta.'new_class'('Perl6Capture', 'parent'=>'Capture Any', 'name'=>'Capture')
     captureproto.'!IMMUTABLE'()
 .end
 
@@ -29,11 +29,24 @@
 
 =cut
 
-.sub 'VTABLE_get_string' :method :vtable('get_string')
-    $S0 = self.'list'()
+.sub '' :vtable('get_string') :method
+    $S0 = self.'item'()
     .return ($S0)
 .end
 
+.sub '' :vtable('get_number') :method
+    $N0 = self.'item'()
+    .return ($N0)
+.end
+
+.sub 'item' :method
+    $P0 = self[0]
+    unless null $P0 goto end
+    $P0 = 'undef'()
+  end:
+    .return ($P0)
+.end
+
 
 =back
 
@@ -49,28 +62,12 @@
 
 .namespace []
 .sub "prefix:\\"
-    .param pmc list            :slurpy
-    .param pmc hash            :slurpy :named
-    .local pmc result, item
-    result = new 'Perl6Capture'
-    setattribute result, '@!list', list
-    item = list
-    $I0 = list.'elems'()
-    if $I0 != 1 goto item_done
-    item = item[0]
-    item = item.'item'()
-  item_done:
-    setattribute result, '$!item', item
-    .local pmc it
-    it = iter hash
-  hash_loop:
-    unless it goto hash_end
-    $S0 = shift it
-    $P0 = hash[$S0]
-    result[$S0] = $P0
-    goto hash_loop
-  hash_end:
-    .return (result)
+    .param pmc arg
+    $I0 = isa arg, 'ObjectRef'
+    if $I0 goto have_ref
+    arg = new 'ObjectRef', arg
+  have_ref:
+    .return (arg)
 .end
 
 # Local Variables:

Modified: branches/rakudoreg/languages/perl6/src/classes/Failure.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Failure.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Failure.pir	Tue Dec 16 08:15:37 2008
@@ -1,8 +1,9 @@
-.namespace []
+# $Id$
+
 
 .namespace [ 'Failure' ]
 
-.sub 'onload' :anon :init :load
+.sub '' :anon :init :load
     .local pmc p6meta, failureproto, exceptionproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     failureproto = p6meta.'new_class'('Failure', 'parent'=>'Undef Any', 'attr'=>'$!exception')
@@ -23,23 +24,59 @@
     set_hll_global 'StrPos', failureproto
 .end
 
+=head2 Methods
 
-.sub '' :method :vtable('get_integer')
-    self.'!throw_unhandled'()
-    .return (0)
+=cut
+
+.sub 'ACCEPTS' :method
+    .param pmc topic
+    $I0 = defined topic
+    if $I0 goto defined
+    .return(1)
+  defined:
+    .return(0)
 .end
 
-.sub '' :method :vtable('get_number')
-    self.'!throw_unhandled'()
-    .return (0.0)
+
+.sub 'defined' :method
+    $P0 = self.'!exception'()
+    $P0['handled'] = 1
+    $P1 = get_hll_global ['Bool'], 'False'
+    .return ($P1)
 .end
 
-.sub '' :method :vtable('get_string')
-    self.'!throw_unhandled'()
-    .return ('')
+
+.sub 'handled' :method
+    .local pmc exception
+    exception = self.'!exception'()
+    $I0 = exception['handled']
+    .return ($I0)
 .end
 
 
+.sub 'perl' :method
+    .return ('undef')
+.end
+
+
+.namespace []
+.sub 'undef'
+    .param pmc x               :slurpy
+    ## 0-argument test, RT#56366
+    ## but see also C<< term:sym<undef> >> in STD.pm
+    unless x goto no_args
+    die "Obsolete use of undef; in Perl 6 please use undefine instead"
+  no_args:
+    $P0 = new 'Failure'
+    .return ($P0)
+.end
+
+
+=head2 Private methods
+
+=cut
+
+.namespace ['Failure']
 .sub '!exception' :method
     .local pmc exception
     exception = getattribute self, '$!exception'
@@ -67,49 +104,38 @@
   done:
 .end
 
-.sub 'ACCEPTS' :method
-    .param pmc topic
-    $I0 = defined topic
-    if $I0 goto defined
-    .return(1)
-  defined:
-    .return(0)
-.end
-
 
-.sub 'defined' :method
-    $P0 = self.'!exception'()
-    $P0['handled'] = 1
-    $P1 = get_hll_global ['Bool'], 'False'
-    .return ($P1)
-.end
+=head2 Vtable functions
 
+=cut
 
-.sub 'handled' :method
-    .local pmc exception
-    exception = self.'!exception'()
-    $I0 = exception['handled']
-    .return ($I0)
+.namespace ['Failure']
+.sub '' :vtable('get_integer') :method
+    self.'!throw_unhandled'()
+    .return (0)
 .end
 
+.sub '' :vtable('get_number') :method
+    self.'!throw_unhandled'()
+    .return (0.0)
+.end
 
-.sub 'perl' :method
-    .return ('undef')
+.sub '' :vtable('get_string') :method
+    self.'!throw_unhandled'()
+    .return ('')
 .end
 
+.sub '' :vtable('get_pmc_keyed') :method
+    .param pmc key
+    .return (self)
+.end
 
-.namespace []
-.sub 'undef'
-    .param pmc x               :slurpy
-    ## 0-argument test, RT#56366
-    ## but see also C<< term:sym<undef> >> in STD.pm
-    unless x goto no_args
-    die "Obsolete use of undef; in Perl 6 please use undefine instead"
-  no_args:
-    $P0 = new 'Failure'
-    .return ($P0)
+.sub '' :vtable('get_pmc_keyed_int') :method
+    .param int key
+    .return (self)
 .end
 
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: branches/rakudoreg/languages/perl6/src/classes/Hash.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Hash.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Hash.pir	Tue Dec 16 08:15:37 2008
@@ -4,14 +4,9 @@
 
 src/classes/Hash.pir - Perl 6 Hash class and related functions
 
-=head2 Object Methods
-
-=over 4
-
 =cut
 
 .namespace []
-
 .sub 'onload' :anon :load :init
     .local pmc p6meta, hashproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
@@ -19,29 +14,30 @@
     hashproto.'!MUTABLE'()
 .end
 
-=item ACCEPTS()
+=head2 Methods
+
+=over 4
 
 =cut
 
-.sub 'hash'
-    .param pmc args            :slurpy
-    .param pmc hash            :slurpy :named
-    args.'!flatten'()
-    unless hash goto hash_done
-    unshift args, hash
-  hash_done:
-    .tailcall args.'hash'()
-.end
+=item ACCEPTS()
 
+=cut
 
 .namespace ['Perl6Hash']
-
 .sub 'ACCEPTS' :method
     .param pmc topic
     .tailcall self.'contains'(topic)
 .end
 
+.namespace ['Perl6Hash']
+.sub 'contains' :method
+    .param pmc key
+    $I0 = exists self[key]
+    .return( $I0 )
+.end
 
+.namespace ['Perl6Hash']
 .sub 'delete' :method
     .param pmc keys :slurpy
     .local pmc result
@@ -49,7 +45,6 @@
     .local pmc tmp
     result = new 'List'
     keys.'!flatten'()
-
   keys_loop:
     unless keys goto done
     key = shift keys
@@ -57,29 +52,109 @@
     push result, tmp
     delete self[key]
     goto keys_loop
-
   done:
     .return (result)
 .end
 
+.namespace ['Perl6Hash']
+.sub 'exists' :method
+    .param pmc key
+    $I0 = exists self[key]
+    .return( $I0 )
+.end
+
+.namespace ['Perl6Hash']
 .sub 'hash' :method
     .return (self)
 .end
 
-.sub 'exists' :method
-    .param pmc key
+.namespace ['Perl6Hash']
+.sub 'Hash' :method
+    .return (self)
+.end
 
-    $I0 = exists self[key]
-    .return( $I0 )
+=back
+
+=head2 Operators
+
+=over
+
+=item circumfix:<{ }>
+
+Create a Hash (hashref).
+
+=cut
+
+.namespace []
+.sub 'circumfix:{ }'
+    .param pmc values :slurpy
+    $P0 = values.'Hash'()
+    $P0 = new 'ObjectRef', $P0
+    .return ($P0)
 .end
 
-.sub 'contains' :method
-    .param pmc key
+=back
 
-    $I0 = exists self[key]
-    .return( $I0 )
+=head2 Private methods
+
+=over
+
+=item !STORE
+
+Store a value into a hash.
+
+=cut
+
+.namespace ['Perl6Hash']
+.sub '!STORE' :method
+    .param pmc source
+    ## we create a new hash here instead of emptying self in case
+    ## the source argument contains self or elements of self.
+    .local pmc hash, it
+    hash = new 'Perl6Hash'
+    source = 'list'(source)
+    it = iter source
+  iter_loop:
+    unless it goto iter_done
+    .local pmc elem, key, value
+    elem = shift it
+    $I0 = does elem, 'hash'
+    if $I0 goto iter_hash
+    $I0 = isa elem, 'Perl6Pair'
+    if $I0 goto iter_pair
+    unless it goto err_odd_list
+    key = elem
+    value = shift it
+    goto iter_kv
+  iter_pair:
+    key = elem.'key'()
+    value = elem.'value'()
+  iter_kv:
+    value = 'Scalar'(value)
+    hash[key] = value
+    goto iter_loop
+  iter_hash:
+    .local pmc hashiter
+    hashiter = iter elem
+  hashiter_loop:
+    unless hashiter goto hashiter_done
+    $S0 = shift hashiter
+    value = elem[$S0]
+    value = 'Scalar'(value)
+    value = clone value
+    hash[$S0] = value
+    goto hashiter_loop
+  hashiter_done:
+    goto iter_loop
+  iter_done:
+    copy self, hash
+    .return (self)
+
+  err_odd_list:
+    die "Odd number of elements found where hash expected"
 .end
 
+
 =back
 
 =cut

Modified: branches/rakudoreg/languages/perl6/src/classes/IO.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/IO.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/IO.pir	Tue Dec 16 08:15:37 2008
@@ -8,15 +8,10 @@
 
 This file implements the IO file handle class.
 
-=head1 Methods
-
-=over 4
-
 =cut
 
 .namespace ['IO']
-
-.sub 'onload' :anon :init :load
+.sub '' :anon :init :load
     .local pmc p6meta
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     p6meta.'new_class'('IO', 'parent'=>'Any', 'attr'=>'$!PIO')
@@ -26,15 +21,54 @@
     '!EXPORT'('lines', 'from'=>$P0)
 .end
 
+=head2 Methods
+
+=over 4
+
+=item close
+
+Closes the file.
+
+=cut
+
+.namespace ['IO']
+.sub 'close' :method
+    .local pmc PIO
+    PIO = getattribute self, "$!PIO"
+    close PIO
+    .return(1)
+.end
+
+
+=item eof
+
+Tests if we have reached the end of the file.
+
+=cut
+
+.namespace ['IO']
+.sub 'eof' :method
+    .local pmc PIO
+    PIO = getattribute self, "$!PIO"
+    if PIO goto not_eof
+    $P0 = get_hll_global [ 'Bool' ], 'True'
+    .return ($P0)
+  not_eof:
+    $P0 = get_hll_global [ 'Bool' ], 'False'
+    .return ($P0)
+.end
+
 
 =item lines
 
 our List multi method lines (IO $handle:) is export;
 
-Returns all the lines of a file as a (lazy) List regardless of context. See also slurp.
+Returns all the lines of a file as a (lazy) List regardless of context.
+See also slurp.
 
 =cut
 
+.namespace ['IO']
 .sub 'lines' :method :multi('IO')
     .local pmc PIO, res, chomper
     PIO = getattribute self, "$!PIO"
@@ -59,6 +93,7 @@
 
 =cut
 
+.namespace ['IO']
 .sub 'print' :method
     .param pmc args            :slurpy
     .local pmc it
@@ -76,22 +111,6 @@
 .end
 
 
-=item say
-
-Writes the given list of items to the file, then a newline character.
-
-=cut
-
-.sub 'say' :method
-    .param pmc list            :slurpy
-    .local pmc PIO
-    PIO = getattribute self, "$!PIO"
-    self.'print'(list)
-    print PIO, "\n"
-    .return (1)
-.end
-
-
 =item printf
 
 Parses a format string and prints formatted output according to it.
@@ -123,57 +142,39 @@
 .end
 
 
-=item slurp
-
-Slurp a file into a string.
-
-=cut
-
-.sub 'slurp' :method
-    .local pmc PIO
-    PIO = getattribute self, "$!PIO"
-    $S0 = PIO.'readall'()
-    .return($S0)
-.end
-
-
-=item eof
+=item say
 
-Tests if we have reached the end of the file.
+Writes the given list of items to the file, then a newline character.
 
 =cut
 
-.sub 'eof' :method
+.sub 'say' :method
+    .param pmc list            :slurpy
     .local pmc PIO
     PIO = getattribute self, "$!PIO"
-    if PIO goto not_eof
-    $P0 = get_hll_global [ 'Bool' ], 'True'
-    .return ($P0)
-  not_eof:
-    $P0 = get_hll_global [ 'Bool' ], 'False'
-    .return ($P0)
+    self.'print'(list)
+    print PIO, "\n"
+    .return (1)
 .end
 
 
-=item close
+=item slurp
 
-Closes the file.
+Slurp a file into a string.
 
 =cut
 
-.sub 'close' :method
+.sub 'slurp' :method
     .local pmc PIO
     PIO = getattribute self, "$!PIO"
-    close PIO
-    .return(1)
+    $S0 = PIO.'readall'()
+    .return($S0)
 .end
 
 
-.namespace []
-
 =back
 
-=head1 EXPORTED MULTI SUBS
+=head2 Functions
 
 =over 4
 
@@ -183,6 +184,7 @@
 
 =cut
 
+.namespace []
 .sub 'prefix:=' :multi('IO')
     .param pmc io
     $P0 = get_hll_global 'IOIterator'
@@ -190,40 +192,23 @@
     .return($P0)
 .end
 
-
-.namespace [ 'IOIterator' ]
-
 =back
 
 =head1 IOIterator
 
 The IOIterator class implements the I/O iterator.
 
-=over 4
-
-=cut
-
-.sub get_bool :method :vtable
-    .local pmc PIO
-    $P0 = getattribute self, "$!IO"
-    PIO = getattribute $P0, "$!PIO"
-    if PIO goto more
-    .return(0)
-more:
-    .return(1)
-.end
+=head2 Methods
 
+=over 4
 
-=item Scalar
+=item item()  (Vtable shift_pmc)
 
-Return the value inside this container in item context.
+Read a single line and return it.
 
 =cut
 
-.sub 'Scalar' :method
-    .tailcall self.'item'()
-.end
-
+.namespace ['IOIterator']
 .sub 'item' :method :vtable('shift_pmc')
     .local pmc pio, chomper
     $P0 = getattribute self, "$!IO"
@@ -233,6 +218,13 @@
     .tailcall chomper($P0)
 .end
 
+=item list()
+
+Read all of the lines and return them as a List.
+
+=cut
+
+.namespace ['IOIterator']
 .sub 'list' :method
     .local pmc pio, res, chomper
     $P0 = getattribute self, "$!IO"
@@ -251,19 +243,67 @@
     .return (res)
 .end
 
-.sub 'get_string' :vtable
+
+=back
+
+=head2 Coercion methods
+
+=item Scalar
+
+Return the value inside this container in item context.
+
+=cut
+
+.namespace ['IOIterator']
+.sub 'Scalar' :method
     .tailcall self.'item'()
 .end
 
-.sub 'get_iter' :method :vtable
-    .return(self)
+
+=back
+
+=head2 Private methods
+
+=over
+
+=item !flatten
+
+Return the remainder of the input in flattening context.
+
+=cut
+
+.namespace ['IOIterator']
+.sub '!flatten' :method
+    .tailcall self.'list'()
 .end
 
 
 =back
 
+=head2 Vtable functions
+
 =cut
 
+.namespace ['IOIterator']
+.sub '' :vtable('get_bool') :method
+    .local pmc PIO
+    $P0 = getattribute self, "$!IO"
+    PIO = getattribute $P0, "$!PIO"
+    if PIO goto more
+    .return (0)
+  more:
+    .return (1)
+.end
+
+.sub '' :vtable('get_iter') :method
+    .return (self)
+.end
+
+.sub '' :vtable('get_string') :method
+    $S0 = self.'item'()
+    .return ($S0)
+.end
+
 
 # Local Variables:
 #   mode: pir

Modified: branches/rakudoreg/languages/perl6/src/classes/List.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/List.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/List.pir	Tue Dec 16 08:15:37 2008
@@ -107,54 +107,6 @@
 .end
 
 
-=item hash()
-
-Return the List invocant as a Hash.
-
-=cut
-
-.namespace ['List']
-.sub 'hash' :method
-    .local pmc result, iter
-    result = new 'Perl6Hash'
-    iter = self.'iterator'()
-  iter_loop:
-    unless iter goto iter_end
-    .local pmc elem, key, value
-    elem = shift iter
-    $I0 = does elem, 'hash'
-    if $I0 goto iter_hash
-    $I0 = isa elem, 'Perl6Pair'
-    if $I0 goto iter_pair
-    unless iter goto err_odd_list
-    value = shift iter
-    value = clone value
-    result[elem] = value
-    goto iter_loop
-  iter_hash:
-    .local pmc hashiter
-    hashiter = elem.'keys'()
-  hashiter_loop:
-    unless hashiter goto hashiter_end
-    $S0 = shift hashiter
-    value = elem[$S0]
-    result[$S0] = value
-    goto hashiter_loop
-  hashiter_end:
-    goto iter_loop
-  iter_pair:
-    key = elem.'key'()
-    value = elem.'value'()
-    result[key] = value
-    goto iter_loop
-  iter_end:
-    .return (result)
-
-  err_odd_list:
-    die "Odd number of elements found where hash expected"
-.end
-
-
 =back
 
 =head2 Methods
@@ -167,6 +119,7 @@
 
 =cut
 
+.namespace ['List']
 .sub 'elems' :method :multi('ResizablePMCArray') :vtable('get_number')
     self.'!flatten'()
     $I0 = elements self
@@ -228,22 +181,14 @@
   flat_loop_1:
     .local pmc elem
     elem = self[i]
-    $I0 = defined elem
-    unless $I0 goto flat_next
     $I0 = isa elem, 'Perl6Scalar'
     unless $I0 goto no_deref
     elem = deref elem
   no_deref:
     $I0 = isa elem, 'ObjectRef'
     if $I0 goto flat_next
-    $I0 = isa elem, 'Range'
-    unless $I0 goto not_range
-    elem = elem.'list'()
-  not_range:
-    $I0 = isa elem, 'IOIterator'
-    unless $I0 goto not_ioiterator
-    elem = elem.'list'()
-  not_ioiterator:
+    $I0 = can elem, '!flatten'
+    if $I0 goto flat_elem
     $I0 = does elem, 'array'
     unless $I0 goto flat_next
     splice self, elem, i, 1
@@ -252,6 +197,13 @@
   flat_next:
     inc i
     goto flat_loop
+  flat_elem:
+    elem = elem.'!flatten'()
+    splice self, elem, i, 1
+    $I0 = elements elem
+    i += $I0
+    len = elements self
+    goto flat_loop
   flat_end:
     $I0 = isa self, 'List'
     if $I0 goto end

Modified: branches/rakudoreg/languages/perl6/src/classes/Mapping.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Mapping.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Mapping.pir	Tue Dec 16 08:15:37 2008
@@ -24,29 +24,16 @@
 
 =item Scalar
 
-When we're going to be stored as an item, become a Hash and then return
-ourself in a ObjectRef.
+When we're going to be stored as an item, become a Hash and
+return an ObjectRef to it.
 
 =cut
 
+.namespace ['Mapping']
 .sub 'Scalar' :method
-    # Create a hash with our values.
-    .local pmc hash, it
-    hash = get_hll_global "Hash"
-    hash = hash.'new'()
-    it = iter self
-  it_loop:
-    unless it goto it_loop_end
-    $P0 = shift it
-    $P1 = self[$P0]
-    hash[$P0] = $P1
-    goto it_loop
-  it_loop_end:
-
-    # Wrap it up in an object ref and return it.
-    .local pmc ref
-    ref = new 'ObjectRef', hash
-    .return (ref)
+    $P0 = self.'Hash'()
+    $P0 = new 'ObjectRef', $P0
+    .return ($P0)
 .end
 
 
@@ -270,65 +257,10 @@
 .end
 
 
-=back
-
-=head1 Functions
-
-=over 4
-
-=back
-
-=head1 TODO: Functions
-
-=over 4
-
-=cut
-
-.namespace []
-
-=item delete
-
- our List  multi method Hash::delete ( *@keys )
- our Scalar multi method Hash::delete ( $key ) is default
-
-Deletes the elements specified by C<$key> or C<$keys> from the invocant.
-returns the value(s) that were associated to those keys.
-
-=item exists
-
- our Bool multi method Hash::exists ( $key )
-
-True if invocant has an element whose key matches C<$key>, false
-otherwise.
-
-=cut
-
-
-=item values
-
- multi Int|List Hash::keys ( %hash : MatchTest *@keytests )
- multi Int|List Hash::kv ( %hash : MatchTest *@keytests )
- multi Int|(List of Pair) Hash::pairs  (%hash : MatchTest *@keytests )
- multi Int|List Hash::values ( %hash : MatchTest *@keytests )
-
-Iterates the elements of C<%hash> in no apparent order, but the order
-will be the same between successive calls to these functions, as long as
-C<%hash> doesn't change.
-
-If C<@keytests> are provided, only elements whose keys evaluate
-C<$key ~~ any(@keytests)> as true are iterated.
-
-What is returned at each element of the iteration varies with function.
-C<keys> only returns the key; C<values> the value; C<kv> returns both as
-a 2 element list in (key, value) order, C<pairs> a C<Pair(key, value)>.
-
-Note that C<kv %hash> returns the same as C<zip(keys %hash; values %hash)>
-
-In Scalar context, they all return the count of elements that would have
-been iterated.
+.sub '!flatten' :method
+    .tailcall self.'pairs'()
+.end
 
-The lvalue form of C<keys> is not longer supported. Use the C<.buckets>
-property instead.
 
 =back
 

Modified: branches/rakudoreg/languages/perl6/src/classes/Nil.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Nil.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Nil.pir	Tue Dec 16 08:15:37 2008
@@ -16,7 +16,7 @@
     nilproto = p6meta.'new_class'('Nil', 'parent'=>'Failure')
 .end
 
-=head2 Context methods
+=head2 Methods
 
 =over
 
@@ -30,6 +30,16 @@
     .return ($P0)
 .end
 
+
+=item 'shift'
+
+=cut
+
+.namespace ['Nil']
+.sub 'shift' :method :vtable('shift_pmc')
+    .return (self)
+.end
+
 =back
 
 =head2 Coercion methods
@@ -40,23 +50,31 @@
 
 =cut
 
+.namespace ['Nil']
 .sub 'Scalar' :method
     $P0 = new 'Failure'
     .return ($P0)
 .end
 
+
 =back
 
-=head2 Methods
+=head2 Private methods
 
-=item 'shift'
+=over
+
+=item !flatten
+
+Return an empty list when flattened.
 
 =cut
 
-.sub 'shift' :method :vtable('shift_pmc')
-    .return (self)
+.namespace ['Nil']
+.sub '!flatten' :method
+    .tailcall self.'list'()
 .end
 
+
 =back
 
 =cut

Modified: branches/rakudoreg/languages/perl6/src/classes/Object.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Object.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Object.pir	Tue Dec 16 08:15:37 2008
@@ -43,14 +43,19 @@
 
 =item hash
 
-Return invocant in hash context.  Default is to build a Hash from C<.list>.
+Return invocant in hash context.
 
 =cut
 
 .namespace ['Perl6Object']
 .sub 'hash' :method
-    $P0 = self.'list'()
-    .tailcall $P0.'hash'()
+    .tailcall self.'Hash'()
+.end
+
+.namespace []
+.sub 'hash'
+    .param pmc values :slurpy
+    .tailcall values.'Hash'()
 .end
 
 =item item
@@ -140,7 +145,18 @@
 .namespace ['Perl6Object']
 .sub 'Array' :method
     $P0 = new 'Perl6Array'
-    'infix:='($P0, self)
+    $P0.'!STORE'(self)
+    .return ($P0)
+.end
+
+=item Hash()
+
+=cut
+
+.namespace ['Perl6Object']
+.sub 'Hash' :method
+    $P0 = new 'Perl6Hash'
+    $P0.'!STORE'(self)
     .return ($P0)
 .end
 
@@ -160,7 +176,8 @@
 
 =cut
 
-.sub 'Scalar' :method
+.namespace ['Perl6Object']
+.sub '' :method('Scalar') :anon
     $I0 = isa self, 'ObjectRef'
     unless $I0 goto not_ref
     .return (self)
@@ -169,6 +186,21 @@
     .return ($P0)
 .end
 
+.namespace []
+.sub 'Scalar'
+    .param pmc source
+    $I0 = isa source, 'ObjectRef'
+    if $I0 goto done
+    $I0 = can source, 'Scalar'
+    if $I0 goto can_scalar
+    $I0 = does source, 'scalar'
+    source = new 'ObjectRef', source
+  done:
+    .return (source)
+  can_scalar:
+    .tailcall source.'Scalar'()
+.end
+
 =item Str()
 
 Return a string representation of the invocant.  Default is
@@ -176,6 +208,7 @@
 
 =cut
 
+.namespace ['Perl6Object']
 .sub 'Str' :method
     $P0 = new 'ResizableStringArray'
     $P1 = self.'WHAT'()

Modified: branches/rakudoreg/languages/perl6/src/classes/Positional.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Positional.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Positional.pir	Tue Dec 16 08:15:37 2008
@@ -43,7 +43,6 @@
     $I0 = args[0]
     result = self[$I0]
     unless null result goto end
-    $P0 = get_hll_global 'Object'
     result = new 'Failure'
     self[$I0] = result
     goto end

Modified: branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir	Tue Dec 16 08:15:37 2008
@@ -39,23 +39,53 @@
 
 .namespace ['P6protoobject']
 .sub 'WHENCE' :method
-    .local pmc props, whence
-    props = getattribute self, '%!properties'
-    if null props goto ret_undef
-    whence = props['WHENCE']
-    if null whence goto ret_undef
-    .return (whence)
-  ret_undef:
+    .local pmc whence
+    whence = getprop '%!WHENCE', self
+    unless null whence goto done
     whence = new 'Undef'
+  done:
     .return (whence)
 .end
 
 =back
 
+=head2 Functions
+
+=over
+
+=item postcircumfix:<{ }>
+
+Return a clone of the protoobject with a new WHENCE property set.
+
+=cut
+
+.namespace ['P6protoobject']
+.sub 'postcircumfix:{ }' :method
+    .param pmc WHENCE :slurpy :named
+    .local pmc protoclass, proto
+    protoclass = typeof self
+    proto = new protoclass
+    setprop proto, '%!WHENCE', WHENCE
+    .return (proto)
+.end
+
+
+=back
+
 =head2  Private methods
 
 =over
 
+=item !flatten()
+
+=cut
+
+.sub '!flatten' :method
+    $P0 = new 'ResizablePMCArray'
+    push $P0, self
+    .return ($P0)
+.end
+
 =item !IMMUTABLE()
 
 =item !MUTABLE()
@@ -79,67 +109,6 @@
 
 =back
 
-=head2 Vtable functions
-
-=over
-
-=item get_pmc_keyed(key)    (vtable method)
-
-Returns a proto-object with an autovivification closure attached to it.
-
-=cut
-
-.sub get_pmc_keyed :vtable :method
-    .param pmc what
-
-    # We'll build auto-vivification hash of values.
-    .local pmc WHENCE, key, val
-    WHENCE = new 'Hash'
-
-    # What is it?
-    $S0 = what.'WHAT'()
-    if $S0 == 'Pair' goto from_pair
-    if $S0 == 'List' goto from_list
-    'die'("Auto-vivification closure did not contain a Pair")
-
-  from_pair:
-    # Just a pair.
-    key = what.'key'()
-    val = what.'value'()
-    WHENCE[key] = val
-    goto done_whence
-
-  from_list:
-    # List.
-    .local pmc list_iter, cur_pair
-    list_iter = iter what
-  list_iter_loop:
-    unless list_iter goto done_whence
-    cur_pair = shift list_iter
-    key = cur_pair.'key'()
-    val = cur_pair.'value'()
-    WHENCE[key] = val
-    goto list_iter_loop
-  done_whence:
-
-    # Now create a clone of the protoobject.
-    .local pmc protoclass, res, props, tmp
-    protoclass = class self
-    res = new protoclass
-
-    # Attach the WHENCE property.
-    props = getattribute self, '%!properties'
-    unless null props goto have_props
-    props = new 'Hash'
-  have_props:
-    props['WHENCE'] = WHENCE
-    setattribute res, '%!properties', props
-
-    .return (res)
-.end
-
-=back
-
 =cut
 
 # Local Variables:

Modified: branches/rakudoreg/languages/perl6/src/classes/Range.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Range.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Range.pir	Tue Dec 16 08:15:37 2008
@@ -6,48 +6,20 @@
 
 =head1 DESCRIPTION
 
-=head2 Methods
-
-=over 4
-
 =cut
 
 .namespace ['Range']
 
-.sub 'onload' :anon :load :init
+.sub '' :anon :load :init
     .local pmc p6meta, rangeproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     rangeproto = p6meta.'new_class'('Range', 'parent'=>'Any', 'attr'=>'$!from $!to $!from_exclusive $!to_exclusive')
     rangeproto.'!IMMUTABLE'()
 .end
 
+=head2 Methods
 
-=item VTABLE_get integer (vtable method)
-
-=item VTABLE_get_number (vtable method)
-
-=item VTABLE_get_string (vtable method)
-
-=cut
-
-.sub 'VTABLE_get_integer' :method :vtable('get_integer')
-    $P0 = self.'list'()
-    $I0 = $P0
-    .return ($I0)
-.end
-
-.sub 'VTABLE_get_number' :method :vtable('get_number')
-    $P0 = self.'list'()
-    $N0 = $P0
-    .return ($N0)
-.end
-
-.sub 'VTABLE_get_string' :method :vtable('get_string')
-    $P0 = self.'list'()
-    $S0 = $P0
-    .return ($S0)
-.end
-
+=over 4
 
 =item ACCEPTS(topic)
 
@@ -120,7 +92,7 @@
 .end
 
 
-=item iterator()  (vtable method)
+=item iterator()  (vtable function)
 
 Return an iterator for the Range.  Since Ranges are already
 iterators, we can just return a clone.
@@ -155,16 +127,20 @@
 .end
 
 
+=item max()
+
 =item min()
 
 =item minmax()
 
-=item max()
-
 =cut
 
 .namespace ['Range']
 
+.sub 'max' :method
+    .tailcall self.'to'()
+.end
+
 .sub 'min' :method
     .tailcall self.'from'()
 .end
@@ -176,8 +152,31 @@
     .tailcall $P2($P0, $P1)
 .end
 
-.sub 'max' :method
-    .tailcall self.'to'()
+
+=item perl()
+
+Returns a Perl representation of the Range.
+
+=cut
+
+.sub 'perl' :method
+    .local string result, tmp
+    .local pmc from, fromexc, toexc, to
+    from = getattribute self, '$!from'
+    fromexc = getattribute self, '$!from_exclusive'
+    toexc = getattribute self, '$!to_exclusive'
+    to = getattribute self, '$!to'
+    result = from.'perl'()
+    unless fromexc goto dots
+    result .= '^'
+  dots:
+    result .= '..'
+    unless toexc goto end
+    result .= '^'
+  end:
+    tmp = to.'perl'()
+    result .= tmp
+    .return (result)
 .end
 
 
@@ -244,32 +243,6 @@
 .end
 
 
-=item perl()
-
-Returns a Perl representation of the Range.
-
-=cut
-
-.sub 'perl' :method
-    .local string result, tmp
-    .local pmc from, fromexc, toexc, to
-    from = getattribute self, '$!from'
-    fromexc = getattribute self, '$!from_exclusive'
-    toexc = getattribute self, '$!to_exclusive'
-    to = getattribute self, '$!to'
-    result = from.'perl'()
-    unless fromexc goto dots
-    result .= '^'
-  dots:
-    result .= '..'
-    unless toexc goto end
-    result .= '^'
-  end:
-    tmp = to.'perl'()
-    result .= tmp
-    .return (result)
-.end
-
 =back
 
 =head2 Operators
@@ -353,6 +326,15 @@
 
 =over 4
 
+=item !flatten()
+
+=cut
+
+.namespace ['Range']
+.sub '!flatten' :method
+    .tailcall self.'list'()
+.end
+
 =item !from_test(topic)
 
 =item !to_test(topic)
@@ -401,6 +383,38 @@
 
 =back
 
+=head2 Vtable functions
+
+=over
+
+=item VTABLE_get integer (vtable method)
+
+=item VTABLE_get_number (vtable method)
+
+=item VTABLE_get_string (vtable method)
+
+=cut
+
+.sub 'VTABLE_get_integer' :method :vtable('get_integer')
+    $P0 = self.'list'()
+    $I0 = $P0
+    .return ($I0)
+.end
+
+.sub 'VTABLE_get_number' :method :vtable('get_number')
+    $P0 = self.'list'()
+    $N0 = $P0
+    .return ($N0)
+.end
+
+.sub 'VTABLE_get_string' :method :vtable('get_string')
+    $P0 = self.'list'()
+    $S0 = $P0
+    .return ($S0)
+.end
+
+=back
+
 =cut
 
 # Local Variables:

Modified: branches/rakudoreg/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rakudoreg/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rakudoreg/languages/perl6/src/parser/actions.pm	Tue Dec 16 08:15:37 2008
@@ -267,8 +267,9 @@
     my $block := $( $<block> );
     $block.blocktype('immediate');
 
-    # XXX TODO: push a control exception throw onto the end of the block so we
-    # exit the innermost block in which $_ was set.
+    # Push a handler onto the innermost block so that we can exit if we
+    # successfully match
+    when_handler_helper($block);
 
     # Invoke smartmatch of the expression.
     my $match_past := PAST::Op.new(
@@ -290,9 +291,65 @@
 
 method default_statement($/) {
     # Always executed if reached, so just produce the block.
-    my $past := $( $<block> );
-    $past.blocktype('immediate');
-    make $past;
+    my $block := $( $<block> );
+    $block.blocktype('immediate');
+
+    # Push a handler onto the innermost block so that we can exit if we
+    # successfully match
+    when_handler_helper($block);
+
+    make $block;
+}
+
+sub when_handler_helper($block) {
+    our $?BLOCK;
+    # XXX TODO: This isn't quite the right way to check this...
+    unless $?BLOCK.handlers() {
+        my @handlers;
+        @handlers.push(
+            PAST::Control.new(
+                PAST::Op.new(
+                    :pasttype('pirop'),
+                    :pirop('return'),
+                    PAST::Var.new(
+                        :scope('keyed'),
+                        PAST::Var.new( :name('exception'), :scope('register') ),
+                        'payload',
+                    ),
+                ),
+                :handle_types('BREAK')
+            )
+        );
+        $?BLOCK.handlers(@handlers);
+    }
+
+    # push a control exception throw onto the end of the block so we
+    # exit the innermost block in which $_ was set.
+    my $last := $block.pop();
+    $block.push(
+        PAST::Op.new(
+            :pasttype('call'),
+            :name('break'),
+            $last
+        )
+    );
+
+    # Push a handler onto the block to handle CONTINUE exceptions so we can
+    # skip throwing the BREAK exception
+    my @handlers;
+    if $block.handlers() {
+        @handlers := $block.handlers();
+    }
+    @handlers.push(
+        PAST::Control.new(
+            PAST::Op.new(
+                :pasttype('pirop'),
+                :pirop('return'),
+            ),
+            :handle_types('CONTINUE')
+        )
+    );
+    $block.handlers(@handlers);
 }
 
 method loop_statement($/) {
@@ -1552,29 +1609,20 @@
         $past := build_call( $( $<semilist> ) );
         $past.node($/);
         $past.name('postcircumfix:[ ]');
-        $past.pasttype('call');
     }
     elsif $key eq '( )' {
         $past := build_call( $( $<semilist> ) );
         $past.node($/);
     }
     elsif $key eq '{ }' {
-        $past := PAST::Var.new(
-            $( $<semilist> ),
-            :scope('keyed'),
-            :vivibase('Perl6Hash'),
-            :viviself('Failure'),
-            :node( $/ )
-        );
+        $past := build_call( $( $<semilist> ) );
+        $past.node($/);
+        $past.name('postcircumfix:{ }');
     }
     elsif $key eq '< >' {
-        $past := PAST::Var.new(
-            $( $<quote_expression> ),
-            :scope('keyed'),
-            :vivibase('Perl6Hash'),
-            :viviself('Failure'),
-            :node( $/ )
-        );
+        $past := build_call( $( $<quote_expression> ) );
+        $past.node($/);
+        $past.name('postcircumfix:{ }');
     }
     else {
         $/.panic("postcircumfix " ~ $key ~ " not yet implemented");
@@ -2689,7 +2737,7 @@
             my @children := @($past[1]);
             $past := PAST::Op.new(
                 :pasttype('call'),
-                :name('hash'),
+                :name('circumfix:{ }'),
                 :node($/)
             );
             for @children {
@@ -3315,7 +3363,7 @@
             $block[0].push( PAST::Var.new( :name($_),
                                            :scope('lexical'),
                                            :isdecl(1),
-                                           :viviself('Perl6Scalar') ) );
+                                           :viviself('Failure') ) );
             $block.symbol($_, :scope('lexical') );
         }
     }

Modified: branches/rakudoreg/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rakudoreg/languages/perl6/src/parser/grammar.pg	(original)
+++ branches/rakudoreg/languages/perl6/src/parser/grammar.pg	Tue Dec 16 08:15:37 2008
@@ -61,22 +61,24 @@
 ##  last ws token matched.
 
 token ws {
-    ##  STD.pm: <?{ $ยข.pos === $!ws_to }>
-    {{  $P0 = get_global '$!ws'
-        if null $P0 goto end
-        $P1 = $P0.'to'()
-        $P2 = match.'to'()
-        if $P1 != $P2 goto end
-        .return (1)
-      end:
-        set_global '$!ws', match
-    }}
-    <!ww>
-    [
-    | <.unsp>
-    | \v+
-    | <.unv>
-    ]*
+    ## short circuit
+    [ <?{{ $P0 = get_global '$!ws'
+           if null $P0 goto noshort
+           $P1 = $P0.'to'()
+           $P2 = match.'to'()
+           if $P1 != $P2 goto noshort
+           .return (1)
+         noshort:
+           set_global '$!ws', match
+           .return (0)
+      }}>
+    | <!ww>
+      [
+      | <.unsp>
+      | \v+
+      | <.unv>
+      ]*
+    ]
 }
 
 token unsp {
@@ -586,7 +588,7 @@
 
 ##  XXX: cheat until we get term:pi, term:rand, term:undef, etc.
 token named_0ary {
-    | [pi|rand|undef|nothing|time] >>
+    | [pi|rand|undef|nothing|time|next|last|continue|break] >>
     | ['...'|'???'|'!!!'|'=<>']
 }
 

Modified: branches/rakudoreg/languages/perl6/t/spectest.data
==============================================================================
--- branches/rakudoreg/languages/perl6/t/spectest.data	(original)
+++ branches/rakudoreg/languages/perl6/t/spectest.data	Tue Dec 16 08:15:37 2008
@@ -1,11 +1,18 @@
 # this is a list of all spec tests that are supposed to pass
 # on current rakudo.
 # empty lines and those beginning with a # are ignored
+#
+# we don't add some files here, although all tests might pass right now
+#
+# S03-operators/overflow.t - passes only if bignum lib is available
+# S03-operators/binding-arrays.t - regressed to allow slices
+# S03-operators/binding-hashes.t - regressed to allow slices
 
 integration/lexical-array-in-inner-block.t
 integration/lexicals-and-attributes.t
 integration/man-or-boy.t
 integration/real-strings.t
+integration/say-crash.t
 integration/substr-after-match-in-gather-in-for.t
 S02-builtin_data_types/anon_block.t
 S02-builtin_data_types/array_extending.t
@@ -56,7 +63,6 @@
 S03-operators/autoincrement.t
 S03-operators/autovivification.t
 S03-operators/binding-closure.t
-S03-operators/binding-hashes.t
 S03-operators/binding-scalars.t
 S03-operators/bit.t
 S03-operators/chained-declarators.t
@@ -81,6 +87,7 @@
 S03-operators/ternary.t
 S03-operators/true.t
 S03-operators/value_equivalence.t
+S04-blocks-and-statements/pointy-rw.t
 S04-declarations/implicit-parameter.t
 S04-declarations/multiple.t
 S04-declarations/my.t
@@ -110,11 +117,13 @@
 S04-statements/until.t
 S04-statements/while.t
 S05-grammar/namespace.t
+S05-grammar/ws.t
 S05-mass/rx.t
 S05-mass/stdrules.t
 S05-match/arrayhash.t
 S05-match/blocks.t
 S05-match/non-capturing.t
+S05-metachars/line-anchors.t
 S05-metachars/newline.t
 S05-metasyntax/changed.t
 S05-metasyntax/charset.t
@@ -128,6 +137,7 @@
 S05-transliteration/with-closure.t
 S06-advanced_subroutine_features/recurse.t
 S06-advanced_subroutine_features/return.t
+S06-currying/named.t
 S06-multi/proto.t
 S06-multi/syntax.t
 S06-multi/type-based.t
@@ -148,7 +158,9 @@
 S06-traits/is-rw.t
 S06-traits/misc.t
 S09-subscript_slice/slice.t
+S10-packages/import.t
 S11-modules/export.t
+S12-attributes/class2.t
 S12-attributes/class.t
 S12-attributes/delegation.t
 S12-attributes/instance.t
@@ -181,9 +193,10 @@
 S12-role/namespaced.t
 S12-subset/multi-dispatch.t
 S12-subset/subtypes.t
-S16-io/basic-open.t
 S16-filehandles/io_in_while_loops.t
+S16-io/basic-open.t
 S16-io/say.t
+S16-unfiled/slurp.t
 S29-any/cmp.t
 S29-array/delete.t
 S29-array/elems.t
@@ -200,6 +213,7 @@
 S29-hash/exists.t
 S29-hash/keys_values.t
 S29-hash/pairs.t
+S29-list/end.t
 S29-list/first.t
 S29-list/grep.t
 S29-list/join.t
@@ -214,6 +228,7 @@
 S29-list/reduce.t
 S29-list/reverse.t
 S29-list/sort.t
+S29-list/uniq.t
 S29-num/abs.t
 S29-num/complex.t
 S29-num/exp.t

Modified: branches/rakudoreg/languages/perl6/tools/test_summary.pl
==============================================================================
--- branches/rakudoreg/languages/perl6/tools/test_summary.pl	(original)
+++ branches/rakudoreg/languages/perl6/tools/test_summary.pl	Tue Dec 16 08:15:37 2008
@@ -100,7 +100,7 @@
         push @fail, "$tname aborted $abort test(s)";
         $test += $abort;
     }
-    printf "%4d %4d %4d %4d %4d %4d\n", 
+    printf "%4d %4d %4d %4d %4d %4d\n",
         $pass, $fail, $todo, $skip, $test, $plan;
     $sum{'pass'} += $pass;  $sum{"$syn-pass"} += $pass;
     $sum{'fail'} += $fail;  $sum{"$syn-fail"} += $fail;



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