Skip to content

Commit

Permalink
Merge branch 'stdier' into nom
Browse files Browse the repository at this point in the history
  • Loading branch information
jnthn committed Dec 10, 2012
2 parents 24e882f + 324cb25 commit 183e0a4
Show file tree
Hide file tree
Showing 3 changed files with 90 additions and 18 deletions.
55 changes: 44 additions & 11 deletions src/Perl6/Grammar.pm
Expand Up @@ -309,6 +309,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token deflongname {
:dba('new name to be defined')
<name> <colonpair>*
}

Expand All @@ -330,18 +331,23 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token ws {
:my $old_highexpect := self.'!fresh_highexpect'();
:dba('whitespace')
[
|| <?MARKED('ws')>
|| <!ww>
[
| <.vws> <.heredoc>
| <.unv>
]*
<?MARKER('ws')>
]
:my $stub := self.'!set_highexpect'($old_highexpect);
}

token unsp {
\\ <?before [\s|'#'] >
# :dba('unspace')
:dba('unspace')
[
| <.vws>
| <.unv>
Expand Down Expand Up @@ -804,9 +810,11 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token statementlist {
:my %*LANG := self.shallow_copy(pir::find_dynamic_lex__Ps('%*LANG'));
:my %*HOW := self.shallow_copy(pir::find_dynamic_lex__Ps('%*HOW'));
:dba('statement list')
:s
[
| $
| <?before <[\)\]\}]>>
| [<statement><.eat_terminator> ]*
]
}
Expand All @@ -820,23 +828,27 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

rule semilist {
:dba('semicolon list')
[
| <?before <[)\]}]> >
| [<statement><.eat_terminator> ]*
]
}

token statement {
:my $*QSIGIL := '';
:my $*SCOPE := '';
:my $*ACTIONS := %*LANG<MAIN-actions>;
<!before <[\])}]> | $ >
<!stopper>
<!!{ nqp::rebless($/.CURSOR, %*LANG<MAIN>) }>
[
| <statement_control>
| <EXPR> <.ws>
| <EXPR> :dba('statement end')
[
|| <?MARKED('endstmt')>
|| <statement_mod_cond> <statement_mod_loop>?
|| <statement_mod_loop>
|| :dba('statement modifier') <.ws> <statement_mod_cond> <statement_mod_loop>?
|| :dba('statement modifier loop') <.ws> <statement_mod_loop>
{
my $sp := $<EXPR><statement_prefix>;
if $sp && $sp<sym> eq 'do' {
Expand All @@ -845,15 +857,19 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}
}
]?
]
| <?before ';'>
| <?before <stopper> >
| {} <.panic: "Bogus statement">
]
}

token eat_terminator {
|| ';'
|| <?MARKED('endstmt')>
|| <?terminator>
|| <?before ')' | ']' | '}' >
|| $
|| <?stopper>
|| <.typed_panic: 'X::Syntax::Confused'>
}

token xblock($*IMPLICIT = 0) {
Expand All @@ -863,6 +879,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {

token pblock($*IMPLICIT = 0) {
:my $*DECLARAND := $*W.stub_code_object('Block');
:dba('parameterized block')
[
| <lambda>
<.newpad>
Expand All @@ -880,6 +897,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {

token block($*IMPLICIT = 0) {
:my $*DECLARAND := $*W.stub_code_object('Block');
:dba('scoped block')
[ <?[{]> || <.missing: 'block'>]
<.newpad>
<blockoid>
Expand Down Expand Up @@ -1247,7 +1265,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
| <identifier>
{ $*key := $<identifier>.Str; }
[
|| <.unsp>? <circumfix> { $*value := $<circumfix>; }
|| <.unsp>? :dba('pair value') <circumfix> { $*value := $<circumfix>; }
|| { $*value := 1; }
]
| :dba('signature') '(' ~ ')' <fakesignature>
Expand Down Expand Up @@ -1814,6 +1832,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {

token scoped($*SCOPE) {
<.end_keyword>
:dba('scoped declarator')
[
:my $*DOC := $*DECLARATOR_DOCS;
:my $*DOCEE;
Expand Down Expand Up @@ -2098,6 +2117,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token defterm {
:dba('new term to be defined')
<identifier>
}

Expand All @@ -2117,6 +2137,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {

token named_param {
:my $*GOAL := ')';
:dba('named parameter')
':'
[
| <name=.identifier> '(' <.ws>
Expand Down Expand Up @@ -2397,6 +2418,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*GOAL := 'endargs';
:my $*QSIGIL := '';
<.ws>
:dba('argument list')
[
| <?stdstopper>
| <EXPR('e=')>
Expand Down Expand Up @@ -2426,9 +2448,12 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token dec_number {
:dba('decimal number')
[
| $<coeff> = [ '.' <frac=.decint> ] <escale>?
| $<coeff> = [ <int=.decint> '.' <frac=.decint> ] <escale>?
| $<coeff> = [ <int=.decint> ] <escale>
]
}

token rad_number {
Expand Down Expand Up @@ -2520,8 +2545,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token quote_mod:sym<b> { <sym> }

proto token quote { <...> }
token quote:sym<apos> { "'" ~ "'" <nibble(self.quote_lang(%*LANG<Q>, "'", "'", ['q']))> }
token quote:sym<dblq> { '"' ~ '"' <nibble(self.quote_lang(%*LANG<Q>, '"', '"', ['qq']))> }
token quote:sym<apos> { :dba('single quotes') "'" ~ "'" <nibble(self.quote_lang(%*LANG<Q>, "'", "'", ['q']))> }
token quote:sym<dblq> { :dba('double quotes') '"' ~ '"' <nibble(self.quote_lang(%*LANG<Q>, '"', '"', ['qq']))> }
token quote:sym<q> {
:my $qm;
'q'
Expand Down Expand Up @@ -2634,15 +2659,16 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token circumfix:sym<( )> { :dba('parenthesized expression') '(' ~ ')' <semilist> }
token circumfix:sym<[ ]> { :dba('array composer') '[' ~ ']' <semilist> }
token circumfix:sym<ang> {
:dba('quote words')
'<' ~ '>'
[
[ <?before 'STDIN>' > <.obs('<STDIN>', '$*IN.lines (or add whitespace to suppress warning)')> ]?
[ <?before '>' > <.obs('<>', 'lines() to read input, (\'\') to represent a null string or () to represent an empty list')> ]?
<nibble(self.quote_lang(%*LANG<Q>, "<", ">", ['q', 'w']))>
]
}
token circumfix:sym«<< >>» { '<<' ~ '>>' <nibble(self.quote_lang(%*LANG<Q>, "<<", ">>", ['qq', 'ww']))> }
token circumfix:sym<« »> { '«' ~ '»' <nibble(self.quote_lang(%*LANG<Q>, "«", "»", ['qq', 'ww']))> }
token circumfix:sym«<< >>» { :dba('shell-quote words') '<<' ~ '>>' <nibble(self.quote_lang(%*LANG<Q>, "<<", ">>", ['qq', 'ww']))> }
token circumfix:sym<« »> { :dba('shell-quote words') '«' ~ '»' <nibble(self.quote_lang(%*LANG<Q>, "«", "»", ['qq', 'ww']))> }
token circumfix:sym<{ }> { <?[{]> <pblock(1)> }
token circumfix:sym<sigil> {
:dba('contextualizer')
Expand Down Expand Up @@ -2684,8 +2710,10 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*SCOPE := "";
:my $*MULTINESS := "";
:my $*OFTYPE;
:dba('prefix or term')
[
|| <prefixish>* <term>
:dba('postfix')
[
|| <?{ $*QSIGIL }>
[
Expand Down Expand Up @@ -2714,6 +2742,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token prefixish {
:dba('prefix or meta-prefix')
[
| <OPER=prefix>
| <OPER=prefix_circumfix_meta_operator>
Expand All @@ -2723,6 +2752,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token infixish {
:dba('infix or meta-infix')
<!infixstopper>
<!stdstopper>
[
Expand Down Expand Up @@ -2753,6 +2783,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {

[ <!{ $*QSIGIL }> [ <.unsp> | '\\' ] ]?

:dba('postfix')
<postfix_prefix_meta_operator>?
[
| <OPER=postfix>
Expand Down Expand Up @@ -2846,6 +2877,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
}

token dottyop {
:dba('dotty method or postfix')
[
| <methodop>
| <!alpha> <postop>
Expand All @@ -2866,6 +2898,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<quote>
[ <?before '(' | '.(' | '\\'> || <.panic: "Quoted method name requires parenthesized arguments"> ]
] <.unsp>?
:dba('method arguments')
[
[
| <?[(]> <args>
Expand Down
43 changes: 37 additions & 6 deletions src/Perl6/World.pm
Expand Up @@ -2011,16 +2011,47 @@ class Perl6::World is HLL::World {
# If the highwater is beyond the current position, force the cursor to
# that location.
my $c := $/.CURSOR;
if $c.'!highwater'() > $c.pos() {
my @expected;
if $c.'!highwater'() >= $c.pos() {
my @raw_expected := $c.'!highexpect'();
$c.'!cursor_pos'($c.'!highwater'());
my %seen;
for @raw_expected {
unless %seen{$_} {
nqp::push(@expected, $_);
%seen{$_} := 1;
}
}
}

# Build and throw exception object.
# Try and better explain "Confused".
my @locprepost := self.locprepost($c);
%opts<line> := HLL::Compiler.lineof($c.orig, $c.pos);
%opts<modules> := p6ize_recursive(@*MODULES);
%opts<pre> := @locprepost[0];
%opts<post> := @locprepost[1];
if $ex.HOW.name($ex) eq 'X::Syntax::Confused' {
my $next := nqp::substr(@locprepost[1], 0, 1);
if $next ~~ /\)|\]|\}|/ {
%opts<reason> := "Unexpected closing bracket";
@expected := [];
}
else {
my $expected_infix := 0;
for @expected {
if nqp::index($_, "infix") >= 0 {
$expected_infix := 1;
last;
}
}
if $expected_infix {
%opts<reason> := "Two terms in a row";
}
}
}

# Build and throw exception object.
%opts<line> := HLL::Compiler.lineof($c.orig, $c.pos);
%opts<modules> := p6ize_recursive(@*MODULES);
%opts<pre> := @locprepost[0];
%opts<post> := @locprepost[1];
%opts<highexpect> := p6ize_recursive(@expected) if @expected;
%opts<is-compile-time> := 1;
for %opts -> $p {
if nqp::islist($p.value) {
Expand Down
10 changes: 9 additions & 1 deletion src/core/Exception.pm
Expand Up @@ -309,6 +309,7 @@ my role X::Comp is Exception {
has $.is-compile-time = False;
has $.pre;
has $.post;
has @.highexpect;
multi method gist(::?CLASS:D:) {
if $.is-compile-time {
my $color = %*ENV<RAKUDO_ERROR_COLOR> // $*OS ne 'MSWin32';
Expand All @@ -318,6 +319,12 @@ my role X::Comp is Exception {
my $eject = $*OS eq 'MSWin32' ?? "<HERE>" !! "\x[23CF]";
my $r = "$red==={$clear}SORRY!$red===$clear\n$.message\nat $.filename():$.line\n------> ";
$r ~= "$green$.pre$yellow$eject$red$.post$clear" if defined $.pre;
if @.highexpect {
$r ~= "\n expecting any of:";
for @.highexpect {
$r ~= "\n $_";
}
}
for @.modules.reverse[1..*] {
$r ~= $_<module>.defined
?? "\n from module $_<module> ($_<filename>:$_<line>)"
Expand Down Expand Up @@ -629,7 +636,8 @@ my class X::Syntax::Pod::BeginWithoutEnd does X::Syntax does X::Pod {
}

my class X::Syntax::Confused does X::Syntax {
method message() { 'Confused' }
has $.reason = 'unknown';
method message() { $.reason eq 'unknown' ?? 'Confused' !! $.reason }
}

my class X::Syntax::Malformed does X::Syntax {
Expand Down

0 comments on commit 183e0a4

Please sign in to comment.