Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
2739 lines (2204 sloc) 67.1 KB
# STD_P5.pm
#
# Copyright 2009-2010, Larry Wall
#
# You may copy this software under the terms of the Artistic License,
# version 2.0 or later.
grammar STD5 is STD;
use DEBUG;
method TOP ($STOP?) {
if defined $STOP {
my $*GOAL ::= $STOP;
self.unitstop($STOP).comp_unit;
}
else {
self.comp_unit;
}
}
##############
# Precedence #
##############
# The internal precedence levels are *not* part of the public interface.
# The current values are mere implementation; they may change at any time.
# Users should specify precedence only in relation to existing levels.
constant %term = (:dba('term') , :prec<z=>);
constant %methodcall = (:dba('methodcall') , :prec<y=>, :assoc<unary>, :uassoc<left>, :fiddly);
constant %autoincrement = (:dba('autoincrement') , :prec<x=>, :assoc<unary>, :uassoc<non>);
constant %exponentiation = (:dba('exponentiation') , :prec<w=>, :assoc<right>);
constant %symbolic_unary = (:dba('symbolic unary') , :prec<v=>, :assoc<unary>, :uassoc<left>);
constant %binding = (:dba('binding') , :prec<u=>, :assoc<non>);
constant %multiplicative = (:dba('multiplicative') , :prec<t=>, :assoc<left>);
constant %additive = (:dba('additive') , :prec<s=>, :assoc<left>);
constant %shift = (:dba('shift') , :prec<r=>, :assoc<left>);
constant %named_unary = (:dba('named unary') , :prec<q=>, :assoc<unary>, :uassoc<left>);
constant %comparison = (:dba('comparison') , :prec<p=>, :assoc<non>, :diffy);
constant %equality = (:dba('equality') , :prec<o=>, :assoc<chain>, :diffy, :iffy);
constant %bitwise_and = (:dba('bitwise and') , :prec<n=>, :assoc<left>);
constant %bitwise_or = (:dba('bitwise or') , :prec<m=>, :assoc<left>);
constant %tight_and = (:dba('tight and') , :prec<l=>, :assoc<left>);
constant %tight_or = (:dba('tight or') , :prec<k=>, :assoc<left>);
constant %range = (:dba('range') , :prec<j=>, :assoc<right>, :fiddly);
constant %conditional = (:dba('conditional') , :prec<i=>, :assoc<right>, :fiddly);
constant %assignment = (:dba('assignment') , :prec<h=>, :assoc<right>);
constant %comma = (:dba('comma operator') , :prec<g=>, :assoc<left>, :nextterm<nulltermish>, :fiddly);
constant %listop = (:dba('list operator') , :prec<f=>, :assoc<unary>, :uassoc<left>);
constant %loose_not = (:dba('not operator') , :prec<e=>, :assoc<unary>, :uassoc<left>);
constant %loose_and = (:dba('loose and') , :prec<d=>, :assoc<left>);
constant %loose_or = (:dba('loose or') , :prec<c=>, :assoc<left>);
constant %LOOSEST = (:dba('LOOSEST') , :prec<a=!>);
constant %terminator = (:dba('terminator') , :prec<a=>, :assoc<list>);
# "epsilon" tighter than terminator
#constant $LOOSEST = %LOOSEST<prec>;
constant $LOOSEST = "a=!"; # XXX preceding line is busted
##############
# Categories #
##############
# Categories are designed to be easily extensible in derived grammars
# by merely adding more rules in the same category. The rules within
# a given category start with the category name followed by a differentiating
# adverbial qualifier to serve (along with the category) as the longer name.
# The endsym context, if specified, says what to implicitly check for in each
# rule right after the initial <sym>. Normally this is used to make sure
# there's appropriate whitespace. # Note that endsym isn't called if <sym>
# isn't called.
my $*endsym = "null";
proto token category {*}
token category:category { <sym> }
token category:p5sigil { <sym> }
proto token p5sigil {*}
token category:p5special_variable { <sym> }
proto token p5special_variable {*}
token category:p5comment { <sym> }
proto token p5comment {*}
token category:p5module_name { <sym> }
proto token p5module_name {*}
token category:p5value { <sym> }
proto token p5value {*}
token category:p5term { <sym> }
proto token p5term {*}
token category:p5number { <sym> }
proto token p5number {*}
token category:p5quote { <sym> }
proto token p5quote () {*}
token category:p5prefix { <sym> }
proto token p5prefix is unary is defequiv(%symbolic_unary) {*}
token category:p5infix { <sym> }
proto token p5infix is binary is defequiv(%additive) {*}
token category:p5postfix { <sym> }
proto token p5postfix is unary is defequiv(%autoincrement) {*}
token category:p5dotty { <sym> }
proto token p5dotty (:$*endsym = 'unspacey') {*}
token category:p5circumfix { <sym> }
proto token p5circumfix {*}
token category:p5postcircumfix { <sym> }
proto token p5postcircumfix is unary {*} # unary as far as EXPR knows...
token category:p5type_declarator { <sym> }
proto token p5type_declarator (:$*endsym = 'spacey') {*}
token category:p5scope_declarator { <sym> }
proto token p5scope_declarator (:$*endsym = 'nofun') {*}
token category:p5package_declarator { <sym> }
proto token p5package_declarator (:$*endsym = 'spacey') {*}
token category:p5routine_declarator { <sym> }
proto token p5routine_declarator (:$*endsym = 'nofun') {*}
token category:p5regex_declarator { <sym> }
proto token p5regex_declarator (:$*endsym = 'spacey') {*}
token category:p5statement_prefix { <sym> }
proto rule p5statement_prefix () {*}
token category:p5statement_control { <sym> }
proto rule p5statement_control (:$*endsym = 'spacey') {*}
token category:p5statement_mod_cond { <sym> }
proto rule p5statement_mod_cond (:$*endsym = 'nofun') {*}
token category:p5statement_mod_loop { <sym> }
proto rule p5statement_mod_loop (:$*endsym = 'nofun') {*}
token category:p5terminator { <sym> }
proto token p5terminator {*}
token unspacey { <.unsp>? }
token endid { <?before <-[ \- \' \w ]> > }
token spacey { <?before <[ \s \# ]> > }
token nofun { <!before '(' | '->(' | '\\' | '\'' | '-' | "'" | \w > }
##################
# Lexer routines #
##################
token ws {
:temp @*STUB = return self if @*MEMOS[self.pos]<ws> :exists;
:my $startpos = self.pos;
:dba('whitespace')
[
| \h+ <![\#\s\\]> { @*MEMOS[$¢.pos]<ws> = $startpos; } # common case
| <?before \w> <?after \w> :::
{ @*MEMOS[$startpos]<ws> :delete; }
<.panic: "Whitespace is required between alphanumeric tokens"> # must \s+ between words
]
||
[
| <.unsp>
| <.vws> <.heredoc>
| <.unv>
| $ {.moreinput }
]*
{{
if ($¢.pos == $startpos) {
@*MEMOS[$¢.pos]<ws> :delete;
}
else {
@*MEMOS[$¢.pos]<ws> = $startpos;
@*MEMOS[$¢.pos]<endstmt> = @*MEMOS[$startpos]<endstmt>
if @*MEMOS[$startpos]<endstmt> :exists;
}
}}
}
token unsp {
<!>
}
token vws {
:dba('vertical whitespace')
\v
[ '#DEBUG -1' { say "DEBUG"; $STD::DEBUG = $*DEBUG = -1; } ]?
}
# We provide two mechanisms here:
# 1) define $*moreinput, or
# 2) override moreinput method
method moreinput () {
$*moreinput.() if $*moreinput;
}
token unv {
:dba('horizontal whitespace')
[
| \h+
| <?before \h* '=' [ \w | '\\'] > ^^ <.pod_comment>
| \h* <comment=p5comment>
]
}
token p5comment:sym<#> {
'#' {} \N*
}
token ident {
<.alpha> \w*
}
token identifier {
<.alpha> \w*
}
# XXX We need to parse the pod eventually to support $= variables.
token pod_comment {
^^ \h* '=' <.unsp>?
[
| 'begin' \h+ <identifier> ::
[
|| .*? "\n" \h* '=' <.unsp>? 'end' \h+ $<identifier> » \N*
|| <?{ $<identifier>.Str eq 'END'}> .*
|| { my $id = $<identifier>.Str; self.panic("=begin $id without matching =end $id"); }
]
| 'begin' » :: \h* [ $$ || '#' || <.panic: "Unrecognized token after =begin"> ]
[ .*? "\n" \h* '=' <.unsp>? 'end' » \N* || { self.panic("=begin without matching =end"); } ]
| 'for' » :: \h* [ <identifier> || $$ || '#' || <.panic: "Unrecognized token after =for"> ]
[.*? ^^ \h* $$ || .*]
| :: .*? ^^ '=cut' » \N*
]
}
###################
# Top-level rules #
###################
# Note: we only check for the stopper. We don't check for ^ because
# we might be embedded in something else.
rule comp_unit {
:my $*begin_compunit = 1;
:my %*LANG;
:my $*PKGDECL ::= "";
:my $*IN_DECL;
:my $*DECLARAND;
:my $*NEWPKG;
:my $*NEWLEX;
:my $*QSIGIL ::= '';
:my $*IN_META = 0;
:my $*QUASIMODO;
:my $*SCOPE = "";
:my $*LEFTSIGIL;
:my %*MYSTERY = ();
:my $*INVOCANT_OK;
:my $*INVOCANT_IS;
:my $*CURLEX;
:my $*MULTINESS = '';
:my $*CURPKG;
{{
%*LANG<MAIN> = ::STD5 ;
%*LANG<Q> = ::STD5::Q ;
%*LANG<Regex> = ::STD5::Regex ;
%*LANG<Trans> = ::STD5::Trans ;
@*WORRIES = ();
self.load_setting($*SETTINGNAME);
my $oid = $*SETTING.id;
my $id = 'MY:file<' ~ $*FILE<name> ~ '>';
$*CURLEX = Stash.new(
'OUTER::' => [$oid],
'!file' => $*FILE, '!line' => 0,
'!id' => [$id],
);
$STD::ALL.{$id} = $*CURLEX;
$*UNIT = $*CURLEX;
$STD::ALL.<UNIT> = $*UNIT;
self.finishlex;
}}
<statementlist>
[ <?unitstopper> || <.panic: "Confused"> ]
# "CHECK" time...
{{
if @*WORRIES {
warn "Potential difficulties:\n " ~ join( "\n ", @*WORRIES) ~ "\n";
}
my $m =.explain_mystery();
warn $m if $m;
}}
}
method explain_mystery() {
my %post_types;
my %unk_types;
my %unk_routines;
my $m = '';
for keys(%*MYSTERY) {
my $p = %*MYSTERY{$_}.<lex>;
if self.is_name($_, $p) {
# types may not be post-declared
%post_types{$_} = %*MYSTERY{$_};
next;
}
next if self.is_known($_, $p) or self.is_known('&' ~ $_, $p);
# just a guess, but good enough to improve error reporting
if $_ lt 'a' {
%unk_types{$_} = %*MYSTERY{$_};
}
else {
%unk_routines{$_} = %*MYSTERY{$_};
}
}
if %post_types {
my @tmp = sort keys(%post_types);
$m ~= "Illegally post-declared type" ~ ('s' x (@tmp != 1)) ~ ":\n";
for @tmp {
$m ~= "\t$_ used at line " ~ %post_types{$_}.<line> ~ "\n";
}
}
if %unk_types {
my @tmp = sort keys(%unk_types);
$m ~= "Undeclared name" ~ ('s' x (@tmp != 1)) ~ ":\n";
for @tmp {
$m ~= "\t$_ used at line " ~ %unk_types{$_}.<line> ~ "\n";
}
}
if %unk_routines {
my @tmp = sort keys(%unk_routines);
$m ~= "Undeclared routine" ~ ('s' x (@tmp != 1)) ~ ":\n";
for @tmp {
$m ~= "\t$_ used at line " ~ %unk_routines{$_}.<line> ~ "\n";
}
}
$m;
}
# Look for an expression followed by a required lambda.
token xblock {
:my $*GOAL ::= '{';
:dba('block expression') '(' ~ ')' <EXPR>
<.ws>
<sblock>
}
token sblock {
:temp $*CURLEX;
:dba('statement block')
[ <?before '{' > || <.panic: "Missing block"> ]
<.newlex>
<blockoid>
{ @*MEMOS[$¢.pos]<endstmt> = 2; }
<.ws>
}
token block {
:temp $*CURLEX;
:dba('scoped block')
[ <?before '{' > || <.panic: "Missing block"> ]
<.newlex>
<blockoid>
<.ws>
}
token blockoid {
# encapsulate braided languages
:temp %*LANG;
<.finishlex>
[
| :dba('block') '{' ~ '}' <statementlist>
| <?terminator> <.panic: 'Missing block'>
| <?> <.panic: "Malformed block">
]
}
# statement semantics
rule statementlist {
:my $*INVOCANT_OK = 0;
:dba('statement list')
''
[
| $
| <?before <[\)\]\}]> >
| [<statement><eat_terminator> ]*
]
}
# embedded semis, context-dependent semantics
rule semilist {
:my $*INVOCANT_OK = 0;
:dba('semicolon list')
''
[
| <?before <[\)\]\}]> >
| [<statement><eat_terminator> ]*
]
}
token label {
:my $label;
<identifier> ':' <?before \s> <.ws>
[ <?{.is_name($label = $<identifier>.Str) }>
<.sorry("Illegal redeclaration of '$label'")>
]?
# add label as a pseudo type
{{ $¢.add_my_name($label); }}
}
token statement {
:my $*QSIGIL ::= 0;
<!before <[\)\]\}]> >
# this could either be a statement that follows a declaration
# or a statement that is within the block of a code declaration
<!!{ $¢ = %*LANG<MAIN>.bless($¢); }>
[
| <label> <statement>
| <statement_control=p5statement_control>
| <EXPR>
:dba('statement end')
<.ws>
:dba('statement modifier')
[
| <statement_mod_loop=p5statement_mod_loop>
| <statement_mod_cond=p5statement_mod_cond>
]?
| <?before ';'>
]
}
token eat_terminator {
[
|| ';' [ <?before $> { $*ORIG ~~ s/\;$/ /; } ]?
|| <?{ @*MEMOS[$¢.pos]<endstmt> }> <.ws>
|| <?terminator>
|| $
|| {{ if @*MEMOS[$¢.pos]<ws> { $¢.pos = @*MEMOS[$¢.pos]<ws>; } }} # undo any line transition
<.panic: "Confused">
]
}
#####################
# statement control #
#####################
rule p5statement_control:use {
:my $longname;
:my $*SCOPE = 'use';
<sym>
[
|| <version=p5versionish> [
|| <?{ substr($<version>[0].Str,0,2) eq 'v5' }>
|| <?{ substr($<version>[0].Str,0,2) eq 'v6' }> [
:my %*LANG;
{
%*LANG<MAIN> = ::STD::P6 ;
%*LANG<Regex> = ::STD::Regex ;
%*LANG<Q> = ::STD::Q ;
%*LANG<Trans> = ::STD::Trans ;
= %*LANG<MAIN>.bless($¢);
}
<.ws> ';'
[ <statementlist> || <.panic: "Bad P6 code"> ]
]
]
|| <module_name=p5module_name>
{
$longname = $<module_name><longname>;
}
<version=p5versionish>?
[
<arglist>?
# {
# $¢.do_use($longname, $<arglist>);
# }
# || {
# $¢.do_use($longname, '');
# }
]
]
}
rule p5statement_control:no {
<sym>
<module_name=p5module_name>[<.spacey><arglist>]?
}
rule p5statement_control:if {
$<sym>=['if'|'unless']
<xblock>
[
[ <!before 'else'\s*'if'> || <.panic: "Please use 'elsif'"> ]
'elsif'<?spacey> <elsif=xblock>
]*
[
'else'<?spacey> <else=sblock>
]?
}
rule p5statement_control:while {
<sym> <xblock>
}
rule p5statement_control:until {
<sym> <xblock>
}
rule p5statement_control:for {
['for'|'foreach']
[
|| '('
<e1=EXPR>? ';'
<e2=EXPR>? ';'
<e3=EXPR>?
')'
|| ['my'? <variable_declarator>]? '(' ~ ')' <EXPR>
|| <.panic: "Malformed loop spec">
]
<sblock>
}
rule p5statement_control:given {
<sym> <xblock>
}
rule p5statement_control:when {
<sym> <xblock>
}
rule p5statement_control:default {<sym> <sblock> }
rule p5statement_prefix:BEGIN {<sym> <sblock> }
rule p5statement_prefix:CHECK {<sym> <sblock> }
rule p5statement_prefix:INIT {<sym> <sblock> }
rule p5statement_control:END {<sym> <sblock> }
#######################
# statement modifiers #
#######################
rule modifier_expr { <EXPR> }
rule p5statement_mod_cond:if {<sym> <modifier_expr> }
rule p5statement_mod_cond:unless {<sym> <modifier_expr> }
rule p5statement_mod_cond:when {<sym> <modifier_expr> }
rule p5statement_mod_loop:while {<sym> <modifier_expr> }
rule p5statement_mod_loop:until {<sym> <modifier_expr> }
rule p5statement_mod_loop:for {<sym> <modifier_expr> }
rule p5statement_mod_loop:given {<sym> <modifier_expr> }
################
# module names #
################
token def_module_name {
<longname>
}
token p5module_name:normal {
<longname>
[ <?before '['> :dba('generic role') '[' ~ ']' <arglist> ]?
}
token vnum {
\d+
}
token p5versionish {
| <p5version>
| <?before \d+'.'\d+> <vnum> +% '.'
}
token p5version {
| 'v' <?before \d+ > :: <vnum> +% '.'
| <?before \d+'.'\d+'.'\d+> <vnum> +% '.'
}
###############
# Declarators #
###############
token variable_declarator {
:my $*IN_DECL = 1;
:my $*DECLARAND;
<variable>
{ $*IN_DECL = 0; $¢.add_variable($<variable>.Str) }
<.ws>
<trait>*
}
rule scoped($*SCOPE) {
:dba('scoped declarator')
[
| <declarator>
| <regex_declarator=p5regex_declarator>
| <package_declarator=p5package_declarator>
]
|| <?before <[A..Z]>><longname>{{
my $t = $<longname>.Str;
if not.is_known($t) {
.sorry("In \"$*SCOPE\" declaration, typename $t must be predeclared (or marked as declarative with :: prefix)");
}
}}
<!> # drop through
|| <.panic: "Malformed $*SCOPE">
}
rule p5scope_declarator:my { <sym> <scoped('my')> }
rule p5scope_declarator:our { <sym> <scoped('our')> }
rule p5scope_declarator:state { <sym> <scoped('state')> }
rule p5package_declarator:package {
:my $*PKGDECL ::= 'package';
<sym> <package_def>
}
rule p5package_declarator:require { # here because of declarational aspects
<sym>
[
|| <version=p5versionish>
|| <module_name=p5module_name> <EXPR>?
|| <EXPR>
]
}
rule package_def {
:my $longname;
:my $*IN_DECL = 'package';
:my $*HAS_SELF = '';
:my $*DECLARAND;
:my $*NEWPKG;
:my $*NEWLEX;
:my $outer = $*CURLEX;
:temp $*CURPKG;
:temp $*CURLEX;
{ $*SCOPE ||= 'our'; }
'' # XXX
[
[ <longname> { $longname = $<longname>[0]; $¢.add_name($longname<name>.Str); } ]?
<.newlex>
<trait>*
<.getdecl>
[
|| <?before '{'>
[
{
# figure out the actual full package name (nested in outer package)
if $longname and $*NEWPKG {
my $shortname = $longname.<name>.Str;
if $*SCOPE eq 'our' {
$*CURPKG = $*NEWPKG // $*CURPKG.{$shortname ~ '::'};
self.deb("added our " ~ $*CURPKG.id) if $*DEBUG +& DEBUG::symtab;
}
else {
$*CURPKG = $*NEWPKG // $*CURPKG.{$shortname ~ '::'};
self.deb("added my " ~ $*CURPKG.id) if $*DEBUG +& DEBUG::symtab;
}
}
$*begin_compunit = 0;
$*UNIT<$?LONGNAME> ||= $longname ?? $longname<name>.Str !! '';
}
{ $*IN_DECL = ''; }
<blockoid>
<.checkyada>
]
|| <?before ';'>
{
$longname orelse.panic("Compilation unit cannot be anonymous");
my $shortname = $longname.<name>.Str;
$*CURPKG = $*NEWPKG // $*CURPKG.{$shortname ~ '::'};
$*begin_compunit = 0;
# XXX throws away any role sig above
$*CURLEX = $outer;
$*UNIT<$?LONGNAME> = $longname<name>.Str;
}
{ $*IN_DECL = ''; }
<statementlist> # whole rest of file, presumably
|| <.panic: "Unable to parse " ~ $*PKGDECL ~ " definition">
]
] || <.panic: "Malformed $*PKGDECL">
}
token declarator {
[
| <variable_declarator>
| '(' ~ ')' <signature> <trait>*
| <routine_declarator=p5routine_declarator>
| <regex_declarator=p5regex_declarator>
| <type_declarator=p5type_declarator>
]
}
token p5multi_declarator:null {
:my $*MULTINESS = '';
<declarator>
}
rule p5routine_declarator:sub { <sym> <routine_def> }
rule parensig {
:dba('signature')
'(' ~ ')' <signature(1)>
}
method checkyada {
try {
my $startsym = self.<blockoid><statementlist><statement>[0]<EXPR><term><sym> // '';
if $startsym eq '...' or $startsym eq '!!!' or $startsym eq '???' {
$*DECLARAND<stub> = 1;
}
};
return self;
}
rule routine_def () {
:temp $*CURLEX;
:my $*IN_DECL = 1;
:my $*DECLARAND;
[
|| <deflongname>
<.newlex(1)>
<parensig>?
<trait>*
<!{
$*IN_DECL = 0;
}>
<blockoid>:!s
{ @*MEMOS[$¢.pos]<endstmt> = 2; }
<.checkyada>
<.getsig>
|| <?before \W>
<.newlex(1)>
<parensig>?
<trait>*
<!{
$*IN_DECL = 0;
}>
<blockoid>:!s
<.checkyada>
<.getsig>
] || <.panic: "Malformed routine">
}
rule trait {
:my $*IN_DECL = 0;
':' <EXPR(item %comma)>
}
#########
# Nouns #
#########
# (for when you want to tell EXPR that infix already parsed the term)
token nullterm {
<?>
}
token nulltermish {
:dba('null term')
[
| <?stdstopper>
| <term=termish>
{
.<PRE> = $<term><PRE>:delete;
.<POST> = $<term><POST>:delete;
.<~CAPS> = $<term><~CAPS>;
}
| <?>
]
}
token termish {
:my $*SCOPE = "";
:my $*VAR;
:dba('prefix or term')
[
| <PRE> [ <!{ my $p = $<PRE>; my @p = @$p; @p[*-1]<O><term> and $<term> = pop @$p }> <PRE> ]*
[ <?{ $<term> }> || <term=p5term> ]
| <term=p5term>
]
# also queue up any postfixes
:dba('postfix')
[
|| <?{ $*QSIGIL }>
[ <?before '[' | '{' > <POST> ]*!
|| <!{ $*QSIGIL }>
<POST>*
]
{
self.check_variable($*VAR) if $*VAR;
.<~CAPS> = $<term><~CAPS>;
}
}
token p5term:fatkey { <fatkey> }
token p5term:variable { <variable>
[
|| <?{ $<variable><sigil>.Str ne '$' }>
|| <?before '['> { $<variable><really> = '@' }
|| <?before '{'> { $<variable><really> = '%' }
]?
{ $*VAR ||= $<variable> }
}
token p5term:package_declarator { <package_declarator=p5package_declarator> }
token p5term:scope_declarator { <scope_declarator=p5scope_declarator> }
token p5term:routine_declarator { <routine_declarator=p5routine_declarator> }
token p5term:circumfix { <circumfix=p5circumfix> }
token p5term:dotty { <dotty=p5dotty> }
token p5term:value { <value=p5value> }
token p5term:capterm { <capterm> }
token p5term:statement_prefix { <statement_prefix=p5statement_prefix> }
token fatkey {
'-'?<key=identifier> <?before \h* '=>' >
}
# Most of these special variable rules are there simply to catch old p5 brainos
token p5special_variable:sym<$!> { <sym> <!before \w> }
token p5special_variable:sym<$!{ }> {
'$!{' ~ '}' <EXPR>
}
token p5special_variable:sym<$/> {
<sym>
}
token p5special_variable:sym<$~> {
<sym>
}
token p5special_variable:sym<$`> {
<sym>
}
token p5special_variable:sym<$@> {
<sym>
}
token p5special_variable:sym<$#> {
<sym>
}
token p5special_variable:sym<$$> {
<sym> <!alpha>
}
token p5special_variable:sym<$%> {
<sym>
}
token p5special_variable:sym<$^X> {
<sigil=p5sigil> '^' $<letter> = [<[A..Z]>] <?before \W >
}
token p5special_variable:sym<$^> {
<sym>
}
token p5special_variable:sym<$&> {
<sym>
}
token p5special_variable:sym<$*> {
<sym>
}
token p5special_variable:sym<$)> {
<sym>
}
token p5special_variable:sym<$-> {
<sym>
}
token p5special_variable:sym<$=> {
<sym>
}
token p5special_variable:sym<@+> {
<sym>
}
token p5special_variable:sym<%+> {
<sym>
}
token p5special_variable:sym<$+[ ]> {
'$+['
}
token p5special_variable:sym<@+[ ]> {
'@+['
}
token p5special_variable:sym<@+{ }> {
'@+{'
}
token p5special_variable:sym<@-> {
<sym>
}
token p5special_variable:sym<%-> {
<sym>
}
token p5special_variable:sym<$-[ ]> {
'$-['
}
token p5special_variable:sym<@-[ ]> {
'@-['
}
token p5special_variable:sym<%-{ }> {
'@-{'
}
token p5special_variable:sym<$+> {
<sym>
}
token p5special_variable:sym<${^ }> {
<sigil=p5sigil> '{^' :: $<text>=[.*?] '}'
}
token p5special_variable:sym<::{ }> {
'::' <?before '{'>
}
token p5special_variable:sym<$[> {
<sym>
}
token p5special_variable:sym<$]> {
<sym>
}
token p5special_variable:sym<$\\> {
<sym>
}
token p5special_variable:sym<$|> {
<sym>
}
token p5special_variable:sym<$:> {
<sym>
}
token p5special_variable:sym<$;> {
<sym>
}
token p5special_variable:sym<$'> { #'
<sym>
}
token p5special_variable:sym<$"> {
<sym> <!{ $*QSIGIL }>
}
token p5special_variable:sym<$,> {
<sym>
}
token p5special_variable:sym['$<'] {
<sym>
}
token p5special_variable:sym«\$>» {
<sym>
}
token p5special_variable:sym<$.> {
<sym>
}
token p5special_variable:sym<$?> {
<sym>
}
# desigilname should only follow a sigil
token desigilname {
[
| <?before '$' > <variable> { $*VAR = $<variable>; }
| <longname>
]
}
token variable {
:my $*IN_META = 0;
:my $sigil = '';
:my $name;
<?before <sigil=p5sigil> {
$sigil = $<sigil>.Str;
}> {}
[
|| '&'
[
| <subname> { $name = $<subname>.Str }
| :dba('infix noun') '[' ~ ']' <infixish(1)>
]
|| [
| <sigil=p5sigil> <desigilname> { $name = $<desigilname>.Str }
| <special_variable=p5special_variable>
| <sigil=p5sigil> $<index>=[\d+]
| <sigil=p5sigil> <?before '{'>
[
| '{' ~ '}' [<name> <postop>?]
| <block>
]
| <sigil=p5sigil> <?{ $*IN_DECL }>
| <?> {{
if $*QSIGIL {
return ();
}
else {
.panic("Anonymous variable requires declarator");
}
}}
]
]
}
# Note, don't reduce on a bare sigil unless you don't care what the longest token is.
token p5sigil:sym<$> { <sym> }
token p5sigil:sym<@> { <sym> }
token p5sigil:sym<%> { <sym> }
token p5sigil:sym<&> { <sym> }
token p5sigil:sym<*> { <sym> }
token p5sigil:sym<$#> { <sym> }
token deflongname {
:dba('new name to be defined')
<name>
{.add_routine($<name>.Str) if $*IN_DECL; }
}
token longname {
<name>
}
token name {
[
| <identifier> <morename>*
| <morename>+
]
}
token morename {
'::' <identifier>?
}
token subname {
<desigilname>
}
token p5value:quote { <quote=p5quote> }
token p5value:number { <number=p5number> }
token p5value:version { <version=p5version> }
# Note: call this only to use existing type, not to declare type
token typename {
[
| '::?'<identifier> # parse ::?CLASS as special case
| <longname>
<?{{
my $longname = $<longname>.Str;
if substr($longname, 0, 2) eq '::' {
.add_my_name(substr($longname, 2));
}
else {
.is_name($longname)
}
}}>
]
# parametric type?
<.unsp>? [ <?before '['> <postcircumfix=p5postcircumfix> ]?
<.ws> [ 'of' <.ws> <typename> ]?
}
token numish {
[
| <integer>
| <dec_number>
| <rad_number>
| 'NaN' »
| 'Inf' »
| '+Inf' »
| '-Inf' »
]
}
token p5number:numish { <numish> }
token integer {
[
| 0 [ b <[01]>+ [ _ <[01]>+ ]*
| x <.xdigit>+ [ _ <.xdigit>+ ]*
| d \d+ [ _ \d+]*
| <[0..7]>+ [ _ <[0..7]>+ ]*
]
| \d+[_\d+]*
]
}
token radint {
[
| <integer>
| <?before ':'> <rad_number> <?{
defined $<rad_number><intpart>
and
not defined $<rad_number><fracpart>
}>
]
}
token escale {
<[Ee]> <[+\-]>? \d+[_\d+]*
}
# careful to distinguish from both integer and 42.method
token dec_number {
:dba('decimal number')
[
| $<coeff> = [ '.' \d+[_\d+]* ] <escale>?
| $<coeff> = [\d+[_\d+]* '.' \d+[_\d+]* ] <escale>?
| $<coeff> = [\d+[_\d+]* ] <escale>
]
<!!before [ '.' <?before \d> <.panic: "Number contains two decimal points (missing 'v' for version number?)">]? >
}
token octints { [<.ws><octint><.ws>] +% ',' }
token octint {
<[ 0..7 ]>+ [ _ <[ 0..7 ]>+ ]*
}
token hexints { [<.ws><hexint><.ws>] +% ',' }
token hexint {
<.xdigit>+ [ _ <.xdigit>+ ]*
}
##########
# Quotes #
##########
our @herestub_queue;
class Herestub {
has Str $.delim;
has $.orignode;
has $.lang;
} # end class
role herestop {
token stopper { ^^ {} $<ws>=(\h*?) $*DELIM \h* <.unv>?? $$ \v? }
} # end role
# XXX be sure to temporize @herestub_queue on reentry to new line of heredocs
method heredoc () {
my $*CTX ::= self.callm if $*DEBUG +& DEBUG::trace_call;
# return if self.peek;
my $here = self;
while my $herestub = shift @herestub_queue {
my $*DELIM = $herestub.delim;
my $lang = $herestub.lang.mixin( ::herestop );
my $doc;
if ($doc) = $here.nibble($lang) {
$here = $doc.trim_heredoc();
$herestub.orignode<doc> = $doc;
}
else {
self.panic("Ending delimiter $*DELIM not found");
}
}
return self.cursor($here.pos); # return to initial type
}
proto token p5backslash {*}
proto token p5escape {*}
token starter { <!> }
token p5escape:none { <!> }
token babble ($l) {
:my $lang = $l;
:my $start;
:my $stop;
\h*
{
($start,$stop) =.peek_delimiters();
$lang = $start ne $stop ?? $lang.balanced($start,$stop)
!! $lang.unbalanced($stop);
$<B> = [$lang,$start,$stop];
}
}
token quibble ($l) {
:my ($lang, $start, $stop);
<babble($l)>
{ my $B = $<babble><B>; ($lang,$start,$stop) = @$B; }
$start <nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ]
{ $lang<_herelang> and.queue_heredoc($<nibble><nibbles>[0]<TEXT>, $lang<_herelang>) }
}
method queue_heredoc($delim, $lang) {
push @herestub_queue, ::Herestub.new(
delim => $delim,
lang => $lang,
orignode => self);
return self;
}
token sibble ($l, $lang2) {
:my ($lang, $start, $stop);
<babble($l)>
{ my $B = $<babble><B>; ($lang,$start,$stop) = @$B; }
$start <left=nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ]
[ <?{ $start ne $stop }>
<.ws> <quibble($lang2)>
||
{ $lang = $lang2.unbalanced($stop); }
<right=nibble($lang)> $stop
]
}
token tribble ($l) {
:my ($lang, $start, $stop);
:my $*GOAL;
<babble($l)>
{ my $B = $<babble>[0]<B>; ($lang,$start,$stop) = @$B; $*GOAL = $stop; }
{ say $lang.WHAT }
[ :lang($lang) $start ~ $stop <left=p5cc($lang)>
[ <?{ $start ne $stop }>
<.ws>
<babble($l)>
{ my $B = $<babble>[0]<B>; ($lang,$start,$stop) = @$B; $*GOAL = $stop; }
[ :lang($lang) $start ~ $stop <right=p5cc> ]
||
{ say.WHAT }
'' ~ $stop <right=p5cc>
]
]
}
# note: polymorphic over many quote languages, we hope
token nibbler {
:my $text = '';
:my $from = self.pos;
:my $to = $from;
:my @nibbles = ();
:my $multiline = 0;
{ $<_from> = self.pos; }
[ <!before <stopper> >
[
|| <starter> <nibbler> <stopper>
{{
push @nibbles, $¢.makestr(TEXT => $text, _from => $from, _pos => $to ) if $from != $to;
my $n = $<nibbler>[*-1]<nibbles>;
my @n = @$n;
push @nibbles, $<starter>;
push @nibbles, @n;
push @nibbles, $<stopper>;
$text = '';
$to = $from =.pos;
}}
|| <escape=p5escape> {{
push @nibbles, $¢.makestr(TEXT => $text, _from => $from, _pos => $to ) if $from != $to;
push @nibbles, $<escape>[*-1];
$text = '';
$to = $from =.pos;
}}
|| .
{{
my $ch = substr($*ORIG, $¢.pos-1, 1);
$text ~= $ch;
$to =.pos;
if $ch ~~ "\n" {
$multiline++;
}
}}
]
]*
{{
push @nibbles, $¢.makestr(TEXT => $text, _from => $from, _pos => $to ) if $from != $to or !@nibbles;
$<nibbles> = \@nibbles;
$<_pos> =.pos;
$<nibbler> :delete;
$<escape> :delete;
$<starter> :delete;
$<stopper> :delete;
$*LAST_NIBBLE = $¢;
$*LAST_NIBBLE_MULTILINE =if $multiline;
}}
}
# and this is what makes nibbler polymorphic...
method nibble ($lang) {
self.cursor_fresh($lang).nibbler;
}
token p5quote:sym<' '> { "'" <nibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q).unbalanced("'"))> "'" }
token p5quote:sym<" "> { '"' <nibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).unbalanced('"'))> '"' }
token p5quote:sym« << » { '<<' ::
[
| <?before '"'> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).cursor_herelang)>
| <?before "'"> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q).cursor_herelang)>
| <identifier>
<.queue_heredoc( $<identifier>.Str,
.cursor_fresh( %*LANG<Q> ).tweak(:qq) )>
| \\ <identifier>
<.queue_heredoc( $<identifier>.Str,
.cursor_fresh( %*LANG<Q> ).tweak(:q) )>
] || <.panic: "Couldn't parse heredoc construct">
}
token p5circumfix:sym«< >» { '<'
<nibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).tweak(:w).balanced('<','>'))> '>' }
token p5quote:sym</ /> {
'/' :: <nibble( $¢.cursor_fresh( %*LANG<Regex> ).unbalanced("/") )> [ '/' || <.panic: "Unable to parse regex; couldn't find final '/'"> ]
<p5rx_mods>?
}
# handle composite forms like qww
token p5quote:qq {
'qq' <?before \W> <.ws> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq))>
}
token p5quote:q {
'q' <?before \W> <.ws> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q))>
}
token p5quote:qw {
'qw' <?before \W> <.ws> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q))>
}
token p5quote:qr {
<sym> » ::
<quibble( $¢.cursor_fresh( %*LANG<Regex> ) )>
<p5rx_mods>?
}
token p5quote:m {
<sym> » ::
<quibble( $¢.cursor_fresh( %*LANG<Regex> ) )>
<p5rx_mods>?
}
token p5quote:s {
<sym> » ::
<pat=sibble( $¢.cursor_fresh( %*LANG<Regex> ), $¢.cursor_fresh( %*LANG<Q> ).tweak(:qq))>
<p5rx_mods>?
}
token p5quote:tr {
<sym> » :: <pat=tribble( $¢.cursor_fresh( %*LANG<Regex> ))>
<p5tr_mods>?
}
token p5rx_mods {
<!after \s>
(< i g s m x c e >+)
}
token p5tr_mods {
(< c d s ] >+)
}
# assumes whitespace is eaten already
method peek_delimiters {
my $pos = self.pos;
my $startpos = $pos;
my $char = substr($*ORIG,$pos++,1);
if $char ~~ /^\s$/ {
self.panic("Whitespace character is not allowed as delimiter"); # "can't happen"
}
elsif $char ~~ /^\w$/ {
self.panic("Alphanumeric character is not allowed as delimiter");
}
elsif %STD::close2open{$char} {
self.panic("Use of a closing delimiter for an opener is reserved");
}
my $rightbrack = %STD::open2close{$char};
if not defined $rightbrack {
return $char, $char;
}
while substr($*ORIG,$pos,1) eq $char {
$pos++;
}
my $len = $pos - $startpos;
my $start = $char x $len;
my $stop = $rightbrack x $len;
return $start, $stop;
}
role startstop[$start,$stop] {
token starter { $start }
token stopper { $stop }
} # end role
role stop[$stop] {
token starter { <!> }
token stopper { $stop }
} # end role
role unitstop[$stop] {
token unitstopper { $stop }
} # end role
token unitstopper { $ }
method balanced ($start,$stop) { self.mixin( ::startstop[$start,$stop] ); }
method unbalanced ($stop) { self.mixin( ::stop[$stop] ); }
method unitstop ($stop) { self.mixin( ::unitstop[$stop] ); }
token charname {
[
| <radint>
| <[a..z A..Z]><-[ \] , \# ]>*?<[a..z A..Z ) ]> <?before \s*<[ \] , \# ]>>
] || <.panic: "Unrecognized character name">
}
token charnames { [<.ws><charname><.ws>] +% ',' }
token charspec {
[
| :dba('character name') '[' ~ ']' <charnames>
| \d+
| <[ ?..Z \\.._ ]>
| <?> <.panic: "Unrecognized \\c character">
]
}
method truly ($bool,$opt) {
return self if $bool;
self.panic("Cannot negate $opt adverb");
}
grammar Q is STD5 {
role b1 {
token p5escape:sym<\\> { <sym> <item=p5backslash> }
token p5backslash:qq { <?before 'q'> { $<quote> =.cursor_fresh(%*LANG<MAIN>).quote(); } }
token p5backslash:sym<\\> { <text=sym> }
token p5backslash:stopper { <text=stopper> }
token p5backslash:a { <sym> }
token p5backslash:b { <sym> }
token p5backslash:c { <sym> <charspec> }
token p5backslash:e { <sym> }
token p5backslash:f { <sym> }
token p5backslash:n { <sym> }
token p5backslash:N { <sym> '{' ~ '}' $<charname>=[.*?] }
token p5backslash:r { <sym> }
token p5backslash:t { <sym> }
token p5backslash:x { :dba('hex character') <sym> [ <.xdigit> <.xdigit>? | '{' ~ '}' <hexints> ] }
# XXX viv doesn't support ** quantifiers yet
token p5backslash:sym<0> { :dba('octal character') <sym> [ [<[0..7]> [<[0..7]> <[0..7]>?]?]? | '{' ~ '}' <octints> ] }
} # end role
role b0 {
token p5escape:sym<\\> { <!> }
} # end role
role c1 {
token p5escape:sym<{ }> { <?before '{'> [ :lang(%*LANG<MAIN>) <block> ] }
} # end role
role c0 {
token p5escape:sym<{ }> { <!> }
} # end role
role s1 {
token p5escape:sym<$> {
:my $*QSIGIL ::= '$';
<?before '$'>
[ :lang(%*LANG<MAIN>) <termish> ] || <.panic: "Non-variable \$ must be backslashed">
}
} # end role
role s0 {
token p5escape:sym<$> { <!> }
} # end role
role a1 {
token p5escape:sym<@> {
:my $*QSIGIL ::= '@';
<?before '@'>
[ :lang(%*LANG<MAIN>) <termish> | <!> ] # trap ABORTBRANCH from variable's ::
}
} # end role
role a0 {
token p5escape:sym<@> { <!> }
} # end role
role h1 {
token p5escape:sym<%> {
:my $*QSIGIL ::= '%';
<?before '%'>
[ :lang(%*LANG<MAIN>) <termish> | <!> ]
}
} # end role
role h0 {
token p5escape:sym<%> { <!> }
} # end role
role f1 {
token p5escape:sym<&> {
:my $*QSIGIL ::= '&';
<?before '&'>
[ :lang(%*LANG<MAIN>) <EXPR(item %methodcall)> | <!> ]
}
} # end role
role f0 {
token p5escape:sym<&> { <!> }
} # end role
role w1 {
method postprocess ($s) { $s.words }
} # end role
role w0 {
method postprocess ($s) { $s }
} # end role
role ww1 {
method postprocess ($s) { $s.words }
} # end role
role ww0 {
method postprocess ($s) { $s }
} # end role
role x1 {
method postprocess ($s) { $s.run }
} # end role
role x0 {
method postprocess ($s) { $s }
} # end role
role q {
token stopper { \' }
token p5escape:sym<\\> { <sym> <item=p5backslash> }
token p5backslash:qq { <?before 'q'> { $<quote> =.cursor_fresh(%*LANG<MAIN>).quote(); } }
token p5backslash:sym<\\> { <text=sym> }
token p5backslash:stopper { <text=stopper> }
# in single quotes, keep backslash on random character by default
token p5backslash:misc { {} (.) { $<text> = "\\" ~ $0.Str; } }
# begin tweaks (DO NOT ERASE)
multi method tweak (:single(:$q)!) { self.panic("Too late for :q") }
multi method tweak (:double(:$qq)!) { self.panic("Too late for :qq") }
# end tweaks (DO NOT ERASE)
} # end role
role qq does b1 does s1 does a1 {
token stopper { \" }
# in double quotes, omit backslash on random \W backslash by default
token p5backslash:misc { {} [ (\W) { $<text> = $0.Str; } | $<x>=(\w) <.panic("Unrecognized backslash sequence: '\\" ~ $<x>.Str ~ "'")> ] }
# begin tweaks (DO NOT ERASE)
multi method tweak (:single(:$q)!) { self.panic("Too late for :q") }
multi method tweak (:double(:$qq)!) { self.panic("Too late for :qq") }
# end tweaks (DO NOT ERASE)
} # end role
role p5 {
# begin tweaks (DO NOT ERASE)
multi method tweak (:$g!) { self }
multi method tweak (:$i!) { self }
multi method tweak (:$m!) { self }
multi method tweak (:$s!) { self }
multi method tweak (:$x!) { self }
multi method tweak (:$p!) { self }
multi method tweak (:$c!) { self }
# end tweaks (DO NOT ERASE)
} # end role
# begin tweaks (DO NOT ERASE)
multi method tweak (:single(:$q)!) { self.truly($q,':q'); self.mixin( ::q ); }
multi method tweak (:double(:$qq)!) { self.truly($qq, ':qq'); self.mixin( ::qq ); }
multi method tweak (:backslash(:$b)!) { self.mixin($b ?? ::b1 !! ::b0) }
multi method tweak (:scalar(:$s)!) { self.mixin($s ?? ::s1 !! ::s0) }
multi method tweak (:array(:$a)!) { self.mixin($a ?? ::a1 !! ::a0) }
multi method tweak (:hash(:$h)!) { self.mixin($h ?? ::h1 !! ::h0) }
multi method tweak (:function(:$f)!) { self.mixin($f ?? ::f1 !! ::f0) }
multi method tweak (:closure(:$c)!) { self.mixin($c ?? ::c1 !! ::c0) }
multi method tweak (:exec(:$x)!) { self.mixin($x ?? ::x1 !! ::x0) }
multi method tweak (:words(:$w)!) { self.mixin($w ?? ::w1 !! ::w0) }
multi method tweak (:quotewords(:$ww)!) { self.mixin($ww ?? ::ww1 !! ::ww0) }
multi method tweak (:$regex!) {
return %*LANG<Regex>;
}
multi method tweak (:$trans!) {
return %*LANG<Trans>;
}
multi method tweak (*%x) {
my @k = keys(%x);
self.panic("Unrecognized quote modifier: " ~ join('',@k));
}
# end tweaks (DO NOT ERASE)
} # end grammar
###########################
# Captures and Signatures #
###########################
token capterm {
'\\'
[
| '(' <capture>? ')'
| <?before \S> <termish>
]
}
rule capture {
:my $*INVOCANT_OK = 1;
<EXPR>
}
rule param_sep { [','|':'|';'|';;'] }
rule signature () {
<variable_declarator>+ % ','
}
token type_constraint {
<typename>
<.ws>
}
rule p5statement_prefix:do {<sym> <block> }
rule p5statement_prefix:eval {<sym> <block> }
#########
# Terms #
#########
# start playing with the setting stubber
token p5term:sym<undef> {
<sym> »
<O(|%term)>
}
token p5term:sym<continue>
{ <sym> » <O(|%term)> }
token p5circumfix:sigil
{ :dba('contextualizer') <sigil=p5sigil> '(' ~ ')' <semilist> { $*LEFTSIGIL ||= $<sigil>.Str } <O(|%term)> }
token p5circumfix:sym<( )>
{ :dba('parenthesized expression') '(' ~ ')' <semilist> <O(|%term)> }
token p5circumfix:sym<[ ]>
{ :dba('array composer') '[' ~ ']' <semilist> <O(|%term)> }
#############
# Operators #
#############
token PRE {
:dba('prefix operator')
<prefix=p5prefix>
{ $<O> = $<prefix><O>; $<sym> = $<prefix><sym> }
<.ws>
}
token infixish ($in_meta = $*IN_META) {
:my $*IN_META = $in_meta;
<!stdstopper>
<!infixstopper>
:dba('infix or meta-infix')
<infix=p5infix>
{ $<O> = $<infix>.<O>; $<sym> = $<infix>.<sym>; }
}
token p5dotty:sym«->» {
<sym> <dottyop>
<O(|%methodcall)> }
token dottyopish {
<term=dottyop>
}
token dottyop {
:dba('dotty method or postfix')
[
| <methodop>
| <!alpha> <postcircumfix=p5postcircumfix> { $<O> = $<postcircumfix><O>; $<sym> = $<postcircumfix><sym>; }
]
}
# Note, this rule mustn't do anything irreversible because it's used
# as a lookahead by the quote interpolator.
token POST {
<!stdstopper>
# last whitespace didn't end here
<!{ @*MEMOS[$¢.pos]<ws> }>
:dba('postfix')
[
| <dotty=p5dotty> { $<O> = $<dotty><O>; $<sym> = $<dotty><sym>; $<~CAPS> = $<dotty><~CAPS>; }
| <postop> { $<O> = $<postop><O>; $<sym> = $<postop><sym>; $<~CAPS> = $<postop><~CAPS>; }
]
}
token p5postcircumfix:sym<( )>
{ :dba('argument list') '(' ~ ')' <semiarglist> <O(|%methodcall)> }
token p5postcircumfix:sym<[ ]>
{ :dba('subscript') '[' ~ ']' <semilist> <O(|%methodcall)> }
token p5postcircumfix:sym<{ }>
{ :dba('subscript') '{' ~ '}' [<identifier><?before '}'>|<semilist>] <O(|%methodcall)> }
token postop {
| <postfix=p5postfix> { $<O> := $<postfix><O>; $<sym> := $<postfix><sym>; }
| <postcircumfix=p5postcircumfix> { $<O> := $<postcircumfix><O>; $<sym> := $<postcircumfix><sym>; }
}
token methodop {
[
| <longname>
| <?before '$' | '@' | '&' > <variable> { $*VAR = $<variable> }
]
:dba('method arguments')
[
| <?[\\(]> <args>
]?
}
token semiarglist {
<arglist> +% ';'
<.ws>
}
token arglist {
:my $inv_ok = $*INVOCANT_OK;
:my $*GOAL ::= 'endargs';
:my $*QSIGIL ::= '';
<.ws>
:dba('argument list')
[
| <?stdstopper>
| <EXPR(item %listop)> {{
my $delims = $<EXPR><delims>;
for @$delims {
if ($_.<sym> // '') eq ':' {
if $inv_ok {
$*INVOCANT_IS = $<EXPR><list>[0];
}
}
}
}}
]
}
token p5circumfix:sym<{ }> {
:: <?before '{' >
<block>
<O(|%term)> }
token p5statement_control:sym<{ }> {
<?before '{' >
<sblock>
<O(|%term)> }
## methodcall
token p5postfix:sym['->'] ()
{ '->' }
## autoincrement
token p5postfix:sym<++>
{ <sym> <O(|%autoincrement)> }
token p5postfix:sym«--»
{ <sym> <O(|%autoincrement)> }
token p5prefix:sym<++>
{ <sym> <O(|%autoincrement)> }
token p5prefix:sym«--»
{ <sym> <O(|%autoincrement)> }
## exponentiation
token p5infix:sym<**>
{ <sym> <O(|%exponentiation)> }
## symbolic unary
token p5prefix:sym<!>
{ <sym> <O(|%symbolic_unary)> }
token p5prefix:sym<+>
{ <sym> <O(|%symbolic_unary)> }
token p5prefix:sym<->
{ <sym> <O(|%symbolic_unary)> }
token p5prefix:sym<~>
{ <sym> <O(|%symbolic_unary)> }
token p5prefix:sym<\\>
{ <sym> <O(|%symbolic_unary)> }
## binding
token p5infix:sym<!~>
{ <sym> <O(|%binding)> }
token p5infix:sym<=~>
{ <sym> <O(|%binding)> }
## multiplicative
token p5infix:sym<*>
{ <sym> <O(|%multiplicative)> }
token p5infix:sym</>
{ <sym> <O(|%multiplicative)> }
token p5infix:sym<%>
{ <sym> <O(|%multiplicative)> }
token p5infix:sym« << »
{ <sym> <O(|%multiplicative)> }
token p5infix:sym« >> »
{ <sym> <O(|%multiplicative)> }
token p5infix:sym<x>
{ <sym> <O(|%multiplicative)> }
## additive
token p5infix:sym<.> ()
{ <sym> <O(|%additive)> }
token p5infix:sym<+>
{ <sym> <O(|%additive)> }
token p5infix:sym<->
{ <sym> <O(|%additive)> }
## bitwise and (all)
token p5infix:sym<&>
{ <sym> <O(|%bitwise_and)> }
token p5infix:sym<also>
{ <sym> <O(|%bitwise_and)> }
## bitwise or (any)
token p5infix:sym<|>
{ <sym> <O(|%bitwise_or)> }
token p5infix:sym<^>
{ <sym> <O(|%bitwise_or)> }
## named unary examples
# (need \s* to win LTM battle with listops)
token p5term:abs
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:alarm
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:chop
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:chdir
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:close
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:closedir
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:caller
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:chr
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:cos
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:chroot
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:defined
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:delete
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:dbmclose
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:exists
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:int
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:exit
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:try
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:eval
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:eof
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:exp
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:each
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:fileno
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:gmtime
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getc
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getpgrp
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getpbyname
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getpwnam
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getpwuid
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getpeername
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:gethostbyname
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getnetbyname
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getsockname
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getgroupnam
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:getgroupgid
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:hex
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:int
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:keys
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:lc
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:lcfirst
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:length
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:localtime
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:log
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:lock
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:lstat
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:ord
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:oct
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:prototype
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:pop
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:pos
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:quotemeta
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:reset
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:rand
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:rmdir
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:readdir
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:readline
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:backtick
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:rewinddir
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:readlink
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:ref
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:chomp
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:scalar
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:sethostent
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:setnetent
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:setservent
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:setprotoent
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:shift
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:sin
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:sleep
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:sqrt
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:srand
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:stat
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:study
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:tell
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:telldir
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:tied
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:uc
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:ucfirst
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:undef
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:untie
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:values
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:write
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:local
{ <sym> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
token p5term:filetest
{ '-'<[a..zA..Z]> » <?before \s*> <.ws> <EXPR(item %named_unary)>? }
## comparisons
token p5infix:sym« <=> »
{ <sym> <?{ $<O><returns> = "Order"; }> <O(|%comparison)> }
token p5infix:cmp
{ <sym> <?{ $<O><returns> = "Order"; }> <O(|%comparison)> }
token p5infix:sym« < »
{ <sym> <O(|%comparison)> }
token p5infix:sym« <= »
{ <sym> <O(|%comparison)> }
token p5infix:sym« > »
{ <sym> <O(|%comparison)> }
token p5infix:sym« >= »
{ <sym> <O(|%comparison)> }
token p5infix:sym<eq>
{ <sym> <O(|%equality)> }
token p5infix:sym<ne>
{ <sym> <O(|%equality)> }
token p5infix:sym<lt>
{ <sym> <O(|%comparison)> }
token p5infix:sym<le>
{ <sym> <O(|%comparison)> }
token p5infix:sym<gt>
{ <sym> <O(|%comparison)> }
token p5infix:sym<ge>
{ <sym> <O(|%comparison)> }
## equality
token p5infix:sym<==>
{ <sym> <!before '=' > <O(|%equality)> }
token p5infix:sym<!=>
{ <sym> <?before \s> <O(|%equality)> }
token p5infix:sym<~~>
{ <sym> <O(|%equality)> }
token p5infix:sym<!~~>
{ <sym> <O(|%equality)> }
## tight and
token p5infix:sym<&&>
{ <sym> <O(|%tight_and)> }
## tight or
token p5infix:sym<||>
{ <sym> <O(|%tight_or)> }
token p5infix:sym<^^>
{ <sym> <O(|%tight_or)> }
token p5infix:sym<//>
{ <sym> <O(|%tight_or)> }
## range
token p5infix:sym<..>
{ <sym> <O(|%range)> }
token p5infix:sym<...>
{ <sym> <O(|%range)> }
## conditional
token p5infix:sym<? :> {
:my $*GOAL ::= ':';
'?'
<.ws>
<EXPR(item %assignment)>
[ ':' ||
[
|| <?before '='> <.panic: "Assignment not allowed within ?:">
|| <?before '!!'> <.panic: "Please use : rather than !!">
|| <?before <infixish>> # Note: a tight infix would have parsed right
<.panic: "Precedence too loose within ?:; use ?(): instead ">
|| <.panic: "Found ? but no :; possible precedence problem">
]
]
{ $<O><_reducecheck> = 'raise_middle'; }
<O(|%conditional)> }
method raise_middle {
self.<middle> = self.<infix><EXPR>;
self;
}
token p5infix:sym<=> ()
{ <sym> <O(|%assignment)> }
## multiplicative
token p5infix:sym<*=>
{ <sym> <O(|%assignment)> }
token p5infix:sym</=>
{ <sym> <O(|%assignment)> }
token p5infix:sym<%=>
{ <sym> <O(|%assignment)> }
token p5infix:sym« <<= »
{ <sym> <O(|%assignment)> }
token p5infix:sym« >>= »
{ <sym> <O(|%assignment)> }
token p5infix:sym<x=>
{ <sym> <O(|%assignment)> }
## additive
token p5infix:sym<.=> ()
{ <sym> <O(|%assignment)> }
token p5infix:sym<+=>
{ <sym> <O(|%additive)> }
token p5infix:sym<-=>
{ <sym> <O(|%assignment)> }
## bitwise and (all)
token p5infix:sym<&=>
{ <sym> <O(|%assignment)> }
## bitwise or (any)
token p5infix:sym<|=>
{ <sym> <O(|%assignment)> }
token p5infix:sym<^=>
{ <sym> <O(|%assignment)> }
## tight and
token p5infix:sym<&&=>
{ <sym> <O(|%assignment)> }
## tight or
token p5infix:sym<||=>
{ <sym> <O(|%assignment)> }
token p5infix:sym<^^=>
{ <sym> <O(|%assignment)> }
token p5infix:sym<//=>
{ <sym> <O(|%assignment)> }
## list item separator
token p5infix:sym<,>
{ <sym> { $<O><fiddly> = 0; } <O(|%comma)> }
token p5infix:sym« => »
{ <sym> { $<O><fiddly> = 0; } <O(|%comma)> }
token p5term:blocklist
{
# :my $name;
# :my $pos;
$<identifier> = ['map'|'grep'|'sort'] <.ws>
[ :my $*IN_SORT = $<identifier>.Str eq 'sort'; <?before '{'> <block> <.ws>]?
<arglist>
# { self.add_mystery($name,$pos,substr($*ORIG,$pos,1)) unless $<args><invocant>; }
<O(|%term)>
}
# force identifier(), identifier.(), etc. to be a function call always
token p5term:identifier
{
:my $name;
:my $pos;
<identifier> ::
{ $name = $<identifier>.Str; $pos =.pos; }
[\h+ <?before '('>]?
<args( $¢.is_name($name) )>
# { self.add_mystery($name,$pos,substr($*ORIG,$pos,1)) unless $<args><invocant>; }
<O(|%term)>
}
token args ($istype = 0) {
:my $listopish = 0;
:my $*GOAL ::= '';
:my $*INVOCANT_OK = 1;
:my $*INVOCANT_IS;
[
# | :dba('argument list') '.(' ~ ')' <semiarglist>
| :dba('argument list') '(' ~ ')' <semiarglist>
| :dba('argument list') <.unsp> '(' ~ ')' <semiarglist>
| { $listopish = 1 } [<?before \s> <!{ $istype }> <.ws> <!infixstopper> <arglist>]?
]
{ $<invocant> = $*INVOCANT_IS; }
}
# names containing :: may or may not be function calls
# bare identifier without parens also handled here if no other rule parses it
token p5term:name
{
:my $name;
:my $pos;
<longname> ::
{
$name = $<longname>.Str;
$pos =.pos;
}
[\h+ <?before '('>]?
<args> # { self.add_mystery($name,$pos,'termish') unless $<args><invocant>; }
<O(|%term)>
}
## loose not
token p5prefix:sym<not>
{ <sym> <?before \s*> <O(|%loose_not)> }
## loose and
token p5infix:sym<and>
{ <sym> <O(|%loose_and)> }
## loose or
token p5infix:sym<or>
{ <sym> <O(|%loose_or)> }
token p5infix:sym<xor>
{ <sym> <O(|%loose_or)> }
## expression terminator
# Note: must always be called as <?terminator> or <?before ...<p5terminator>...>
token p5terminator:sym<;>
{ ';' <O(|%terminator)> }
token p5terminator:sym<if>
{ 'if' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<unless>
{ 'unless' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<while>
{ 'while' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<until>
{ 'until' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<for>
{ 'for' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<given>
{ 'given' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<when>
{ 'when' » <.nofun> <O(|%terminator)> }
token p5terminator:sym<)>
{ <sym> <O(|%terminator)> }
token p5terminator:sym<]>
{ ']' <O(|%terminator)> }
token p5terminator:sym<}>
{ '}' <O(|%terminator)> }
token p5terminator:sym<:>
{ ':' <?{ $*GOAL eq ':' }> <O(|%terminator)> }
regex infixstopper {
:dba('infix stopper')
[
| <?before <stopper> >
| <?before ':' > <?{ $*GOAL eq ':' }>
]
}
# overridden in subgrammars
token stopper { <!> }
# hopefully we can include these tokens in any outer LTM matcher
regex stdstopper {
:temp @*STUB = return self if @*MEMOS[self.pos]<endstmt> :exists;
:dba('standard stopper')
[
| <?terminator>
| <?unitstopper>
| $ # unlikely, check last (normal LTM behavior)
]
{ @*MEMOS[$¢.pos]<endstmt> ||= 1; }
}
## vim: expandtab sw=4 ft=perl6
grammar Regex is STD {
# begin tweaks (DO NOT ERASE)
multi method tweak (:global(:$g)!) { self }
multi method tweak (:ignorecase(:$i)!) { self }
# end tweaks (DO NOT ERASE)
token category:p5metachar { <sym> }
proto token p5metachar {*}
token category:p5backslash { <sym> }
proto token p5backslash {*}
token category:p5assertion { <sym> }
proto token p5assertion {*}
token category:p5quantifier { <sym> }
proto token p5quantifier {*}
token category:p5mod_internal { <sym> }
proto token p5mod_internal {*}
proto token p5regex_infix {*}
# suppress fancy end-of-line checking
token codeblock {
:my $*GOAL ::= '}';
'{' :: [ :lang($¢.cursor_fresh(%*LANG<MAIN>)) <statementlist> ]
[ '}' || <.panic: "Unable to parse statement list; couldn't find right brace"> ]
}
token ws {
<?{ $*RX<s> }>
|| [ <?before \s | '#'> <.nextsame> ]? # still get all the pod goodness, hopefully
}
token nibbler {
:temp $*ignorecase;
<alternation>
}
regex infixstopper {
:dba('infix stopper')
<?before <stopper> >
}
token p5regex_infix:sym<|> { <sym> <O(|%tight_or)> }
token alternation {
<sequence>+ % <p5regex_infix>
}
token sequence {
<quantified_atom>*
}
token quantified_atom {
<!stopper>
<!p5regex_infix>
<atom>
[ <.ws> <quantifier=p5quantifier>
# <?{ $<atom>.max_width }>
# || <.panic: "Cannot quantify zero-width atom">
]?
}
token atom {
[
| \w
| <metachar=p5metachar>
| '\\' :: .
| :: \W
]
}
# sequence stoppers
token p5metachar:sym<|> { '|' :: <fail> }
token p5metachar:sym<)> { ')' :: <fail> }
token p5metachar:quant { <quantifier=p5quantifier> <.panic: "quantifier quantifies nothing"> }
# "normal" metachars
token p5metachar:sym<[ ]> {
# Unix-style character classes are quite metafiddly. Don't blame me.
'[' ~ ']' [ $<neg> = [ '^' ]? <p5cc> ]
}
token p5cc {
:my $stop = $*GOAL || ']';
[
<p5ccelem>
{
given $<p5ccelem>[*-1].Str {
if /\-/ {
for split('-', $_) {
if /\\(d|w|s|D|W|S)/ {
.panic("Illegal use of $_ in range");
}
}
}
}
}
]+? <?before $stop>
}
token p5ccelem {
[ \\ <p5ccback> || . ]
[ '-' [ \\ <p5ccback> || <-[ \] ]> ]]?
}
proto token p5ccback {*}
token p5ccback:stopper { <text=.stopper> }
token p5ccback:b { :i <sym> }
token p5ccback:d { :i <sym> }
token p5ccback:e { :i <sym> }
token p5ccback:f { :i <sym> }
token p5ccback:h { :i <sym> }
token p5ccback:n { <sym> }
token p5ccback:N { <sym> '{' ~ '}' $<charname>=[.*?] }
token p5ccback:o { :i :dba('octal character') <sym> [ <octint> | '{' ~ '}' <octints> ] }
token p5ccback:r { :i <sym> }
token p5ccback:s { :i <sym> }
token p5ccback:t { :i <sym> }
token p5ccback:v { :i <sym> }
token p5ccback:w { :i <sym> }
token p5ccback:x { :i :dba('hex character') <sym> [ <.xdigit> <.xdigit>? | '{' ~ '}' <hexints> ] }
token p5ccback:sym<0> { :dba('octal character') <sym> [ [<[0..7]> [<[0..7]> <[0..7]>?]?]? | '{' ~ '}' <octints> ] }
token p5metachar:sym«(? )» {
'(?' {} <assertion=p5assertion>
[ ')' || <.panic: "Perl 5 regex assertion not terminated by parenthesis"> ]
}
token p5metachar:sym<( )> {
'(' {} [:lang(self.unbalanced(')')) <nibbler>]?
[ ')' || <.panic: "Unable to parse Perl 5 regex; couldn't find right parenthesis"> ]
{ $/<sym> := <( )> }
}
token p5metachar:sym<\\> { <sym> <backslash=p5backslash> }
token p5metachar:sym<.> { <sym> }
token p5metachar:sym<^> { <sym> }
token p5metachar:sym<$> {
'$' <?before \W | $>
}
token p5metachar:var {
<?before '$'>
<variable>
}
token p5backslash:A { <sym> }
token p5backslash:a { <sym> }
token p5backslash:b { :i <sym> }
token p5backslash:c { :i <sym>
<[ ?.._ ]> || <.panic: "Unrecognized \\c character">
}
token p5backslash:d { :i <sym> }
token p5backslash:e { :i <sym> }
token p5backslash:f { :i <sym> }
token p5backslash:h { :i <sym> }
token p5backslash:l { :i <sym> }
token p5backslash:n { :i <sym> }
token p5backslash:o { :dba('octal character') '0' [ <octint> | '{' ~ '}' <octints> ] }
token p5backslash:p { :i <sym> '{' <[\w:]>+ '}' }
token p5backslash:Q { <sym> }
token p5backslash:r { :i <sym> }
token p5backslash:s { :i <sym> }
token p5backslash:t { :i <sym> }
token p5backslash:u { :i <sym> }
token p5backslash:v { :i <sym> }
token p5backslash:w { :i <sym> }
token p5backslash:x { :i :dba('hex character') <sym> [ <hexint> | '{' ~ '}' <hexints> ] }
token p5backslash:z { :i <sym> }
token p5backslash:misc { $<litchar>=(\W) | $<number>=(\d+) }
token p5backslash:oops { <.panic: "Unrecognized Perl 5 regex backslash sequence"> }
token p5assertion:sym<?> { <sym> <codeblock> }
token p5assertion:sym<{ }> { <codeblock> }
token p5assertion:sym«<» { <sym> <?before '=' | '!'> <assertion=p5assertion> }
token p5assertion:sym<=> { <sym> [ <?before ')'> | <rx> ] }
token p5assertion:sym<!> { <sym> [ <?before ')'> | <rx> ] }
token p5assertion:sym«>» { <sym> <rx> }
token rx {
# [:lang(self.unbalanced(')')) <nibbler>]
<nibbler>
[ <?before ')'> || <.panic: "Unable to parse Perl 5 regex; couldn't find right parenthesis"> ]
}
#token p5assertion:identifier { <longname> [ # is qq right here?
# | <?before ')' >
# | <.ws> <nibbler>
# ]
# [ ':' <rx> ]?
#}
token p5mod { <[imox]>* }
token p5mods { <on=p5mod> [ '-' <off=p5mod> ]? }
token p5assertion:mod { <mods=p5mods> [ # is qq right here?
| ':' <rx>?
| <?before ')' >
]
}
token p5assertion:bogus { <.panic: "Unrecognized Perl 5 regex assertion"> }
token p5quantifier:sym<*> { <sym> <quantmod> }
token p5quantifier:sym<+> { <sym> <quantmod> }
token p5quantifier:sym<?> { <sym> <quantmod> }
token p5quantifier:sym<{ }> { '{' \d+ [','\d*]? '}' <quantmod> }
token quantmod { [ '?' | '+' ]? }
} # end grammar
method check_variable ($variable) {
my $name = $variable.Str;
my $here = self.cursor($variable.from);
self.deb("check_variable $name") if $*DEBUG +& DEBUG::symtab;
if $variable<really> { $name = $variable<really> ~ substr($name,1) }
my ($sigil, $first) = $name ~~ /(\$|\@|\%|\&|\*)(.?)/;
return self if $first eq '{';
my $ok = 0;
$ok ||= $*IN_DECL;
$ok ||= $first lt 'A';
$ok ||= $sigil eq '*';
$ok ||= self.is_known($name);
$ok ||= ($*IN_SORT and $name eq '$a' || $name eq '$b');
if not $ok {
my $id = $name;
$id ~~ s/^\W\W?//;
if $sigil eq '&' {
$here.add_mystery($variable.<sublongname>, self.pos, 'var')
}
elsif $name eq '@_' or $name eq '%_' {
;
}
else { # guaranteed fail now
if my $scope = @*MEMOS[$variable.from]<declend> {
return $here.sorry("Variable $name is not predeclared (declarators are tighter than comma, so maybe your '$scope' signature needs parens?)");
}
elsif $id !~~ /\:\:/ {
if self.is_known('@' ~ $id) {
return $here.sorry("Variable $name is not predeclared (did you mean \@$id?)");
}
elsif self.is_known('%' ~ $id) {
return $here.sorry("Variable $name is not predeclared (did you mean \%$id?)");
}
}
return $here.sorry("Variable $name is not predeclared");
}
}
elsif $*CURLEX{$name} {
$*CURLEX{$name}<used>++;
}
self;
}
Something went wrong with that request. Please try again.