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;
