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