# New Ticket Created by Stephen Weeks
# Please include the string: [perl #59410]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=59410 >
This patch adds support for handling CONTROL_LOOP_NEXT exceptions in
pct-generated for loops. It also adds a 'next' sub to both rakudo and
cardinal.
Cardinal's works fine, but with this patch, rakudo hangs while building.
Specifically, on parrot -o perl6.pbc perl6.pir.
I don't yet have time to track it down more than this beyond gdb always
showing parrot somewhere inside imcc when I looked.
I don't quite have time to track this down right now, but this is a
desired feature for rakudo, so I'll put it here for now.
>From 3a8fe82c992dac72a77df35a984a02db3808c372 Mon Sep 17 00:00:00 2001
From: Stephen Weeks <[EMAIL PROTECTED]>
Date: Sat, 27 Sep 2008 01:14:22 -0600
Subject: [PATCH] [pct]
* Generate an exception handler for CONTROL_LOOP_NEXT exceptions in for loops
[perl6]
* Add a 'next' sub to throw CONTROL_LOOP_NEXT exceptions
[cardinal]
* Add a 'next' sub to throw CONTROL_LOOP_NEXT exceptions
---
MANIFEST | 1 +
compilers/pct/src/PAST/Compiler.pir | 21 +++++++++++++++++----
include/parrot/exceptions.h | 6 +++++-
languages/cardinal/config/makefiles/root.in | 1 +
languages/cardinal/src/builtins/control.pir | 17 +++++++++++++++++
languages/cardinal/src/parser/actions.pm | 5 ++++-
languages/cardinal/t/07-loops.t | 15 ++++++++++++---
languages/perl6/src/builtins/control.pir | 11 +++++++++++
8 files changed, 68 insertions(+), 9 deletions(-)
create mode 100644 languages/cardinal/src/builtins/control.pir
diff --git a/MANIFEST b/MANIFEST
index c5a5c64..c94b2a7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1216,6 +1216,7 @@ languages/c99/t/spi.t
[c99]
languages/cardinal/cardinal.pir [cardinal]
languages/cardinal/config/makefiles/root.in [cardinal]
languages/cardinal/src/builtins/cmp.pir [cardinal]
+languages/cardinal/src/builtins/control.pir [cardinal]
languages/cardinal/src/builtins/eval.pir [cardinal]
languages/cardinal/src/builtins/globals.pir [cardinal]
languages/cardinal/src/builtins/guts.pir [cardinal]
diff --git a/compilers/pct/src/PAST/Compiler.pir
b/compilers/pct/src/PAST/Compiler.pir
index 6eec545..f5ddbe4 100644
--- a/compilers/pct/src/PAST/Compiler.pir
+++ b/compilers/pct/src/PAST/Compiler.pir
@@ -1125,24 +1125,31 @@ by C<node>.
$P0 = get_hll_global ['POST'], 'Ops'
ops = $P0.'new'('node'=>node)
- .local pmc looplabel, endlabel
+ .local pmc looplabel, nextlabel, endlabel
$P0 = get_hll_global ['POST'], 'Label'
$S0 = self.'unique'('for_')
looplabel = $P0.'new'('result'=>$S0)
- $S0 = concat $S0, '_end'
- endlabel = $P0.'new'('result'=>$S0)
+ $S1 = concat $S0, '_next'
+ nextlabel = $P0.'new'('result'=>$S1)
+ $S2 = concat $S0, '_end'
+ endlabel = $P0.'new'('result'=>$S2)
.local pmc collpast, collpost
collpast = node[0]
collpost = self.'as_post'(collpast, 'rtype'=>'P')
ops.'push'(collpost)
- .local string iter
+ .local string iter, next_handler
iter = self.'uniquereg'('P')
ops.'result'(iter)
$S0 = self.'uniquereg'('I')
ops.'push_pirop'('defined', $S0, collpost)
ops.'push_pirop'('unless', $S0, endlabel)
+ next_handler = self.'uniquereg'('P')
+ ops.'push_pirop'('new', next_handler, "'ExceptionHandler'")
+ ops.'push_pirop'('set_addr', next_handler, nextlabel)
+ ops.'push_pirop'('callmethod', 'handle_types', next_handler,
.CONTROL_LOOP_NEXT)
+ ops.'push_pirop'('push_eh', next_handler)
ops.'push_pirop'('iter', iter, collpost)
ops.'push'(looplabel)
ops.'push_pirop'('unless', iter, endlabel)
@@ -1183,7 +1190,13 @@ by C<node>.
ops.'push'(subpost)
ops.'push_pirop'('call', subpost, arglist :flat)
ops.'push_pirop'('goto', looplabel)
+ ops.'push'(nextlabel)
+ ops.'push_pirop'('.local pmc exception')
+ ops.'push_pirop'('.get_results (exception)')
+ ops.'push_pirop'('set', next_handler, 0)
+ ops.'push_pirop'('goto', looplabel)
ops.'push'(endlabel)
+ ops.'push_pirop'('pop_eh')
.return (ops)
.end
diff --git a/include/parrot/exceptions.h b/include/parrot/exceptions.h
index cab79aa..6363c4e 100644
--- a/include/parrot/exceptions.h
+++ b/include/parrot/exceptions.h
@@ -88,7 +88,11 @@ typedef enum {
CONTROL_BREAK,
CONTROL_CONTINUE,
CONTROL_ERROR,
- CONTROL_TAKE
+ CONTROL_TAKE,
+
+ CONTROL_LOOP_NEXT,
+ CONTROL_LOOP_LAST,
+ CONTROL_LOOP_REDO
} exception_type_enum;
/* &end_gen */
diff --git a/languages/cardinal/config/makefiles/root.in
b/languages/cardinal/config/makefiles/root.in
index b94b8b9..99e011c 100644
--- a/languages/cardinal/config/makefiles/root.in
+++ b/languages/cardinal/config/makefiles/root.in
@@ -45,6 +45,7 @@ SOURCES = cardinal.pir \
BUILTINS_PIR = \
src/builtins/guts.pir \
+ src/builtins/control.pir \
src/builtins/say.pir \
src/builtins/cmp.pir \
src/builtins/op.pir \
diff --git a/languages/cardinal/src/builtins/control.pir
b/languages/cardinal/src/builtins/control.pir
new file mode 100644
index 0000000..bf61f0c
--- /dev/null
+++ b/languages/cardinal/src/builtins/control.pir
@@ -0,0 +1,17 @@
+.include 'include/except_severity.pasm'
+.include 'include/except_types.pasm'
+
+.sub 'next'
+ .local pmc e
+ e = new 'Exception'
+ e['type'] = .CONTROL_LOOP_NEXT
+ e['severity'] = .EXCEPT_NORMAL
+ throw e
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
diff --git a/languages/cardinal/src/parser/actions.pm
b/languages/cardinal/src/parser/actions.pm
index f0ac120..b9a1d4f 100644
--- a/languages/cardinal/src/parser/actions.pm
+++ b/languages/cardinal/src/parser/actions.pm
@@ -419,7 +419,10 @@ method for_stmt($/) {
}
method control_command($/,$key) {
- $/.panic("next, break, and redo aren't implemented yet");
+ make PAST::Op.new(
+ :pasttype('call'),
+ :name(~$/),
+ );
}
method module($/) {
diff --git a/languages/cardinal/t/07-loops.t b/languages/cardinal/t/07-loops.t
index 052d634..443fb6d 100644
--- a/languages/cardinal/t/07-loops.t
+++ b/languages/cardinal/t/07-loops.t
@@ -1,13 +1,22 @@
-puts "1..8"
+require 'test'
+plan 12
i = 1
while i < 5
- puts "ok ", i
+ ok(i < 5, 'while loop')
i = i + 1
end
a = [ 5, 6, 7, 8 ]
for i in a
- puts "ok ", i
+ ok(i < 9, 'for loop')
end
+
+a = [1,2,3,4,5,6,7,8]
+
+for i in a
+ next if i % 2
+ nok(i % 2, 'next in for loop')
+end
+
diff --git a/languages/perl6/src/builtins/control.pir
b/languages/perl6/src/builtins/control.pir
index d37e61c..df22cbc 100644
--- a/languages/perl6/src/builtins/control.pir
+++ b/languages/perl6/src/builtins/control.pir
@@ -114,6 +114,17 @@ the moment -- we'll do more complex handling a bit later.)
continuation()
.end
+=item next
+
+=cut
+
+.sub 'next'
+ .local pmc e
+ e = new 'Exception'
+ e['severity'] = .EXCEPT_NORMAL
+ e['type'] = .CONTROL_LOOP_NEXT
+ throw e
+.end
=item term:...
--
1.5.5.1
