Author: kjs
Date: Sun Jan 6 06:07:10 2008
New Revision: 24599
Added:
trunk/languages/punie/t/base_while.t (contents, props changed)
Modified:
trunk/languages/punie/lib/punie-actions.pm
trunk/languages/punie/lib/punie.pg
Log:
[punie]
o add basic while/until loop
o add basic test for both.
o labels are not handled yet.
Modified: trunk/languages/punie/lib/punie-actions.pm
==============================================================================
--- trunk/languages/punie/lib/punie-actions.pm (original)
+++ trunk/languages/punie/lib/punie-actions.pm Sun Jan 6 06:07:10 2008
@@ -95,6 +95,40 @@
make $past;
}
+method loop($/, $key) {
+ # TODO: handle $<label>
+ my $past := $( $/{$key} );
+ make $past
+}
+
+method while_loop($/) {
+ my $past := PAST::Op.new( :pasttype( 'while' ), :node($/) );
+ my $cond;
+
+ if $<expr> {
+ $cond := $( $<expr>[0] );
+ }
+ else {
+ # no condition means true; make the condition true.
+ $cond := PAST::Val.new( :value('1'), :returns('Integer'), :node($/) );
+ }
+
+ my $block := $( $<block> );
+ $past.push($cond);
+ $past.push($block);
+
+ make $past;
+}
+
+method until_loop($/) {
+ my $past := PAST::Op.new( :pasttype( 'until' ), :node($/) );
+ my $cond := $( $<expr> );
+ my $block := $( $<block> );
+ $past.push($cond);
+ $past.push($block);
+ make $past;
+}
+
method integer($/) {
make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node( $/ ) );
}
Modified: trunk/languages/punie/lib/punie.pg
==============================================================================
--- trunk/languages/punie/lib/punie.pg (original)
+++ trunk/languages/punie/lib/punie.pg Sun Jan 6 06:07:10 2008
@@ -18,11 +18,13 @@
}
token line {
- <label>
- [ <cond> {*} #= cond
- | <subroutine> {*} #= subroutine
- | <expr> ';' {*} #= expr
- ] \s*
+ | <loop> {*} #= loop
+ | <label>
+ [ <cond> {*} #= cond
+ | <subroutine> {*} #= subroutine
+ | <expr> ';' {*} #= expr
+ ] \s*
+
}
rule label { [<word>\:]? {*} }
@@ -39,6 +41,23 @@
{*}
}
+rule loop {
+ <label>
+ [ <while_loop> {*} #= while_loop
+ | <until_loop> {*} #= until_loop
+ ]
+}
+
+rule while_loop {
+ while \( <expr>? \) <block>
+ {*}
+}
+
+rule until_loop {
+ until \( <expr> \) <block>
+ {*}
+}
+
rule expr {
| <gprint> {*} #= gprint
| <oexpr> {*} #= oexpr
Added: trunk/languages/punie/t/base_while.t
==============================================================================
--- (empty file)
+++ trunk/languages/punie/t/base_while.t Sun Jan 6 06:07:10 2008
@@ -0,0 +1,26 @@
+#!perl
+
+# Copyright (C) 2005-2007, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw(t . lib ../lib ../../lib ../../../lib);
+use Parrot::Test tests => 1;
+use Test::More;
+
+language_output_is( 'punie', <<'CODE', <<'OUT', 'simple loops' );
+while (0) {
+ print "nok 1\n";
+}
+print "ok 1\n";
+
+until (1) {
+ print "nok 2\n";
+}
+print "ok 2\n";
+
+CODE
+ok 1
+ok 2
+OUT
