Author: tene
Date: Mon Dec 15 18:07:26 2008
New Revision: 33942
Modified:
trunk/languages/perl6/src/builtins/control.pir
trunk/languages/perl6/src/parser/actions.pm
trunk/languages/perl6/src/parser/grammar.pg
Log:
[rakudo]: Basic support for continue and break in given/when.
Modified: trunk/languages/perl6/src/builtins/control.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/control.pir (original)
+++ trunk/languages/perl6/src/builtins/control.pir Mon Dec 15 18:07:26 2008
@@ -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
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Mon Dec 15 18:07:26 2008
@@ -258,11 +258,59 @@
}
method when_statement($/) {
+ our $?BLOCK;
my $block := $( $<block> );
$block.blocktype('immediate');
- # XXX TODO: push a control exception throw onto the end of the block so we
+ # Push a handler onto the innermost block so that we can exit if we
+ # successfully match
+ # 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);
# Invoke smartmatch of the expression.
my $match_past := PAST::Op.new(
@@ -283,10 +331,61 @@
}
method default_statement($/) {
+ our $?BLOCK;
# 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
+ # 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);
+ make $block;
}
method loop_statement($/) {
Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg (original)
+++ trunk/languages/perl6/src/parser/grammar.pg Mon Dec 15 18:07:26 2008
@@ -588,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] >>
| ['...'|'???'|'!!!'|'=<>']
}
