package Pugs::Grammar::StatementControl; use strict; use warnings; use base qw(Pugs::Grammar::BaseCategory); BEGIN { for my $trait ( qw( BEGIN | CHECK | INIT | END | START | FIRST | ENTER | LEAVE | KEEP | UNDO | NEXT | LAST | PRE | POST | CATCH | CONTROL ) ) { __PACKAGE__->add_rule( $trait => qq( ? { return { trait => '$trait', \%{ \$_[0]{'Pugs::Grammar::Perl6.block'}->() }, } } ) ); } __PACKAGE__->add_rule( 'continue' => q( { return { statement => 'continue', } } ) ); __PACKAGE__->add_rule( 'break' => q( { return { statement => 'break', } } ) ); __PACKAGE__->add_rule( 'given' => q( # { print "statement given \n"; } $ := ? $ := { return { statement => 'given', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ) ); __PACKAGE__->add_rule( 'when' => q( # { print "statement when \n"; } $ := ? $ := { return { statement => 'when', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ) ); __PACKAGE__->add_rule( 'default' => q( # { print "statement default \n"; } $ := { return { statement => 'default', exp1 => $_[0]{exp1}->(), } } ) ); __PACKAGE__->add_rule( 'for' => q( #{ print "statement for \n"; } $ := ? $ := # { print "parsed so far: ", '!', $_[0], '!', Dumper( $_[0]->data ); } { return { statement => 'for', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ) ); __PACKAGE__->add_rule( 'while' => q( $ := ? $ := { return { statement => 'while', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ) ); __PACKAGE__->add_rule( 'until' => q( $ := ? $ := { return { statement => 'until', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ) ); __PACKAGE__->add_rule( 'loop' => q( [ '(' $ := ? ';' $ := ? ';' $ := ? ')' ? $ := { return { statement => 'loop', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), exp3 => $_[0]{exp3}->(), content => $_[0]{content}->() } } | ? { return { statement => 'loop', content => $_[0]{'Pugs::Grammar::Perl6.block'}->() } } | # XXX better error messages { return { die "invalid loop syntax" } } ] ) ); __PACKAGE__->add_rule( 'unless' => q( $ := ? $ := [ ? else ? $ := { return { statement => 'unless', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), exp3 => $_[0]{exp3}->(), } } | ? elsif ? $ := ? $ := [ ? else ? $ := { return { statement => 'unless', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), exp3 => $_[0]{exp3}->(), exp4 => $_[0]{exp4}->(), exp5 => $_[0]{exp5}->(), } } # TODO: elsif ... | { return { statement => 'unless', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), exp3 => $_[0]{exp3}->(), exp4 => $_[0]{exp4}->(), } } ] | { return { statement => 'unless', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ] ) ); __PACKAGE__->add_rule( 'else' => q( { die "bare 'else'" } ) ); __PACKAGE__->add_rule( 'if' => q( $ := ? $ := [ ? else ? $ := { return { statement => 'if', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), else => $_[0]{exp3}->(), } } | [ ? elsif ? $ := ? $ := ]+ [ ? else ? $ := { return { statement => 'if', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), elsif => [ $_[0]{exp3}, $_[0]{exp4} ], else => $_[0]{exp5}->(), } } | { return { statement => 'if', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), elsif => [ $_[0]{exp3}, $_[0]{exp4} ], } } ] | { return { statement => 'if', exp1 => $_[0]{exp1}->(), exp2 => $_[0]{exp2}->(), } } ] ) ); __PACKAGE__->add_rule( 'repeat' => q( [ (while|until) ? ? ? { return { statement => 'repeat', which => $_[0][0]->(), exp2 => $_[0]{'Pugs::Grammar::Expression.parse'}->(), postfix => 1, content => $_[0]{'Pugs::Grammar::Perl6.block'}->() } } | ? (while|until) ? ? { return { statement => 'repeat', which => $_[0][0]->(), exp2 => $_[0]{'Pugs::Grammar::Expression.parse'}->(), postfix => 1, content => $_[0]{'Pugs::Grammar::Perl6.block'}->() } } | # XXX better error messages { return { die "invalid repeat syntax" } } ] ) ); __PACKAGE__->recompile; } 1;