# Perl6 implementation of the 'Term' syntax category
# author: Flavio S. Glock - fglock@gmail.com
use v6-alpha;
grammar Pugs::Grammar::Perl6
does Pugs::Grammar::BaseCategory;
use Pugs::Compiler::Rule;
use Pugs::Runtime::Match;
use Pugs::Grammar::StatementControl;
use Pugs::Grammar::StatementModifier;
use Pugs::Grammar::Expression;
use Pugs::Grammar::Pod;
use Pugs::Grammar::P6Rule;
token perl6_expression_or_null {
<Pugs::Grammar::Expression.parse('no_blocks',1)>
{ return $/{'Pugs::Grammar::Expression.parse'}() }
|
{ return { null => 1, } }
}
token block {
\{ <?ws>? <statements> <?ws>? \}
{
#print "matched block\n", Dumper( $/{statements}->data );
return {
bare_block => $/{statements}(),
}
}
|
\{ <?ws>? \}
{
return {
bare_block => { statements => [] }
}
}
|
<'->'>
[
<?ws>? <signature_no_invocant> <?ws>?
\{ <?ws>? <statements> <?ws>? \}
{ return {
pointy_block => $/{statements}(),
signature => $/{signature_no_invocant}(),
} }
|
<?ws>?
\{ <?ws>? <statements> <?ws>? \}
{ return {
pointy_block => $/{statements}(),
signature => undef,
} }
]
}
token attribute {
(<alnum>+) <?ws> ( [<alnum>|_|\\:\\:]+)
[
<?ws> <attribute>
{ return [
[ { bareword => $/[0]() }, { bareword => $/[1]() } ],
@{$<attribute>()},
] }
|
{ return [[ { bareword => $/[0]() }, { bareword => $/[1]() } ]] }
]
|
(\\:<alnum>+)
[
<?ws>? <attribute>
{ return [
[ { bareword => $/[0]() }, { num => 1 } ],
@{$<attribute>()},
] }
|
{ return [[ { bareword => $/[0]() }, { num => 1 } ]] }
]
|
{ return [] }
}
# Str|Num
token signature_term_type {
<Pugs::Grammar::Term.bare_ident>
[
<?ws>? \| <?ws>? <signature_term_type>
{ return {
op1 => '|',
exp1 => $/{'Pugs::Grammar::Term.bare_ident'}(),
exp2 => $<signature_term_type>(),
} }
|
{ return $/{'Pugs::Grammar::Term.bare_ident'}() }
]
|
{ return undef }
}
token signature_term_ident {
# XXX t/subroutines/multidimensional_arglists.t
\\@ ; <?Pugs::Grammar::Term.ident>
{ return { die => "not implemented" } }
|
( ( <'$'>|<'%'>|<'@'>|<'&'> ) <?Pugs::Grammar::Term.ident> )
{ return $/[0]() }
}
token signature_term {
<signature_term_type> : <?ws>?
(<':'>?)
(<'*'>?)
<signature_term_ident>
(<'?'>?)
(<?ws>? <'='> <Pugs::Grammar::Expression.parse('no_blocks', 1)>)?
<?ws>? <attribute>
{ return {
default => $/[3] ? $/[3][0]{'Pugs::Grammar::Expression.parse'}() : undef,
type => $/{signature_term_type}(),
name => $/{signature_term_ident}(),
attribute => $/{attribute}(),
named_only => $/[0](),
is_slurpy => $/[1](),
optional => $/[2](),
} }
}
token signature_no_invocant {
<signature_term>
[
<?ws>? <','> <?ws>? <signature_no_invocant>
{ return [
$/{signature_term}(),
@{$/{signature_no_invocant}()},
] }
|
{ return [ $/{signature_term}() ] }
]
|
{ return [] }
}
token signature {
<signature_term> <?ws>? <':'>
[
<?ws>? <signature_no_invocant>
{ return [
{
%{$/{signature_term}()},
invocant => 1,
},
@{$/{signature_no_invocant}()},
] }
|
{ return [
{
%{$/{signature_term}()},
invocant => 1,
},
] }
]
|
<signature_no_invocant>
{ return $/{signature_no_invocant}() }
}
token category_name {
<Pugs::Grammar::Term.bare_ident>
[ <':'>
[
<before \{ >
<%Pugs::Grammar::Term::hash>
{ return {
category => $/{'Pugs::Grammar::Term.bare_ident'}(),
name => {
'exp1' => {
'hash' => '%::_V6_GRAMMAR::' .
$/{'Pugs::Grammar::Term.bare_ident'}(), },
'exp2' => $/{'Pugs::Grammar::Term::hash'}
()->{bare_block},
'fixity' => 'postcircumfix',
'op1' => { 'op' => '{' },
'op2' => { 'op' => '}' },
}
} }
|
#<before \< >
<%Pugs::Grammar::Quote::hash>
{ return {
category => $/{'Pugs::Grammar::Term.bare_ident'}(),
name => {
'exp1' => {
'hash' => '%::_V6_GRAMMAR::' . $/{'Pugs::Grammar::Term.bare_ident'}(), },
'exp2' => $/{'Pugs::Grammar::Quote::hash'}(),
'fixity' => 'postcircumfix',
'op1' => { 'op' => '<' },
'op2' => { 'op' => '>' },
}
} }
]
|
{ return {
category => '',
name => $/{'Pugs::Grammar::Term.bare_ident'}(),
} }
]
|
{ return {
category => '',
name => '',
} }
}
token sub_signature {
<'('> <?ws>? <signature> <?ws>? <')'>
{
#print "sig ", Dumper( $/{signature}() );
return $/{signature}()
}
|
{ return [] }
}
token sub_decl {
[
( multi | <null> ) <?ws>?
( submethod | method | sub ) <?ws>?
|
( multi ) <?ws>?
( <null> )
]
<category_name> <?ws>?
<sub_signature> <?ws>?
<attribute> <?ws>?
<block>
{
return {
multi => $/[0](),
term => $/[1]() || 'sub',
category => $/{category_name}()->{category},
name => $/{category_name}()->{name},
attribute => $/{attribute}(),
signature => $/{sub_signature}(),
block => $/{block}(),
} }
}
token rule_decl {
( multi | <null> ) <?ws>?
( rule | regex | token ) <?ws>?
<category_name> <?ws>?
<sub_signature> <?ws>?
<attribute> <?ws>?
<'{'> <?ws>?
[
<Pugs::Grammar::P6Rule.rule> <?ws>?
<'}'>
{ return {
multi => $/[0](),
term => $/[1](),
category => $/{category_name}()->{category},
name => $/{category_name}()->{name},
attribute => $/{attribute}(),
signature => $/{sub_signature}(),
# pass the match tree to the emitter
block => $/{'Pugs::Grammar::P6Rule.rule'}(),
} }
|
# XXX better error messages
{ return { die "invalid rule syntax" } }
]
}
# class
token class_decl_name {
( class | grammar | module | role | package ) <?ws>?
( <?Pugs::Grammar::Term.cpan_bareword> | <?Pugs::Grammar::Term.bare_ident> | <null> )
{ return {
statement => $/[0](),
name => $/[1](),
} }
}
token class_decl {
<class_decl_name> <?ws>?
<attribute> <?ws>?
<block>?
{
#print "matched block\n", Dumper( $/{block}[0]->data );
return {
term => $/{class_decl_name}()->{statement},
name => $/{class_decl_name}()->{name},
attribute => $/{attribute}(),
block => defined $/{block}[0]
? $/{block}[0]()
: undef ,
} }
}
# /class
token statement {
<Pugs::Grammar::StatementControl.parse>
{
return $/->{'Pugs::Grammar::StatementControl.parse'}();
}
|
<Pugs::Grammar::Expression.parse('allow_modifier', 1)>
{
return $/{'Pugs::Grammar::Expression.parse'}();
}
}
token statements {
[ ; <?ws>? ]*
[
<before <'}'> > { $::_V6_SUCCEED = 0 }
|
<statement>
<?ws>? [ ; <?ws>? ]*
[
<before <'}'> > { $::_V6_SUCCEED = 0 }
|
<statements>
{ return {
statements => [
$/{statement}(),
@{ $/{statements}()->{statements} },
]
}
}
|
{
return {
statements => [ $/{statement}() ],
} }
]
]
}
token parse {
<?ws>? <statements> <?ws>?
{ return $/{statements}() }
}