Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

viv+STD_P5 now parses all of viv

  • Loading branch information...
commit b759d673570e934bc6045badb69eb47302009b94 1 parent d93fffe
Larry Wall TimToady authored
Showing with 95 additions and 108 deletions.
  1. +5 −0 Actions.pm
  2. +10 −11 STD.pm6
  3. +72 −84 STD_P5.pm6
  4. +8 −13 viv
5 Actions.pm
View
@@ -384,6 +384,11 @@ sub nibbler {
$r->{BEG} = $r->{'.'}->{BEG} // $match->{_from};
$r->{END} = $r->{'.'}->{END} // $match->{_pos};
}
+ elsif ($match->{alternation}) { # regex?
+ $r->{'.'} = $match->{alternation}->{_ast};
+ $r->{BEG} = $r->{'.'}->{BEG} // $match->{_from};
+ $r->{END} = $r->{'.'}->{END} // $match->{_pos};
+ }
my $class = 'VAST::nibbler';
# print STDERR ::Dump($r);
21 STD.pm6
View
@@ -556,16 +556,15 @@ token quibble ($l) {
$start <nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ]
- {
- if $lang<_herelang> {
- push @herestub_queue,
- ::Herestub.new(
- delim => $<nibble><nibbles>[0]<TEXT>,
- orignode => $¢,
- lang => $lang<_herelang>,
- );
- }
- }
+ { $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 quotepair {
@@ -5250,7 +5249,7 @@ grammar Regex is STD {
}
token quantifier:sym<~> {
- <sym> :: <normspace>? <quantified_atom> <normspace>? <quantified_atom>
+ <sym> :: <sigmaybe> <quantified_atom> <sigmaybe> <quantified_atom>
}
token quantifier:sym<~~> {
156 STD_P5.pm6
View
@@ -73,7 +73,6 @@ constant $LOOSEST = "a=!"; # XXX preceding line is busted
# isn't called.
my $*endsym = "null";
-my $*endargs = -1;
proto token category {*}
@@ -154,7 +153,7 @@ proto token p5terminator {*}
token unspacey { <.unsp>? }
token endid { <?before <-[ \- \' \w ]> > }
token spacey { <?before <[ \s \# ]> > }
-token nofun { <!before '(' | '.(' | '\\' | '\'' | '-' | "'" | \w > }
+token nofun { <!before '(' | '->(' | '\\' | '\'' | '-' | "'" | \w > }
##################
# Lexer routines #
@@ -257,7 +256,6 @@ token pod_comment {
# we might be embedded in something else.
rule comp_unit {
:my $*begin_compunit = 1;
- :my $*endargs = -1;
:my %*LANG;
:my $*PKGDECL ::= "";
:my $*IN_DECL;
@@ -361,7 +359,17 @@ token xblock {
:my $*GOAL ::= '{';
:dba('block expression') '(' ~ ')' <EXPR>
<.ws>
- <block>
+ <sblock>
+}
+
+token sblock {
+ :temp $*CURLEX;
+ :dba('scoped block')
+ [ <?before '{' > || <.panic: "Missing block"> ]
+ <.newlex>
+ <blockoid>
+ { @*MEMOS[$¢.pos]<endstmt> = 2; }
+ <.ws>
}
token block {
@@ -370,6 +378,7 @@ token block {
[ <?before '{' > || <.panic: "Missing block"> ]
<.newlex>
<blockoid>
+ <.ws>
}
token blockoid {
@@ -382,44 +391,6 @@ token blockoid {
| <?terminator> <.panic: 'Missing block'>
| <?> <.panic: "Malformed block">
]
-
- [
- | <?before \h* $$> # (usual case without comments)
- { @*MEMOS[$¢.pos]<endstmt> = 2; }
- | \h* <?before <[\\,:]>>
- | <.unv>? $$
- { @*MEMOS[$¢.pos]<endstmt> = 2; }
- | {} <.unsp>? { @*MEMOS[$¢.pos]<endargs> = 1; }
- ]
-}
-
-token regex_block {
- # encapsulate braided languages
- :temp %*LANG;
-
- :my $lang = %*LANG<Regex>;
- :my $*GOAL ::= '}';
-
- [ <quotepair> <.ws>
- {
- my $kv = $<quotepair>[*-1];
- $lang = $lang.tweak($kv.<k>, $kv.<v>)
- or self.sorry("Unrecognized adverb :" ~ $kv.<k> ~ '(' ~ $kv.<v> ~ ')');
- }
- ]*
-
- '{'
- <nibble( $¢.cursor_fresh($lang).unbalanced('}') )>
- [ '}' || <.panic: "Unable to parse regex; couldn't find right brace"> ]
-
- [
- | <?before \h* $$> # (usual case without comments)
- { @*MEMOS[$¢.pos]<endstmt> = 2; }
- | \h* <?before <[\\,:]>>
- | <.unv>? $$
- { @*MEMOS[$¢.pos]<endstmt> = 2; }
- | {} <.unsp>? { @*MEMOS[$¢.pos]<endargs> = 1; }
- ]
}
# statement semantics
@@ -460,7 +431,6 @@ token label {
}
token statement {
- :my $*endargs = -1;
:my $*QSIGIL ::= 0;
<!before <[\)\]\}]> >
@@ -536,7 +506,7 @@ rule p5statement_control:if {
'elsif'<?spacey> <elsif=xblock>
]*
[
- 'else'<?spacey> <else=block>
+ 'else'<?spacey> <else=sblock>
]?
}
@@ -559,7 +529,7 @@ rule p5statement_control:for {
|| ['my'? <variable_declarator>]? '(' ~ ')' <EXPR>
|| <.panic: "Malformed loop spec">
]
- <block>
+ <sblock>
}
rule p5statement_control:given {
@@ -568,12 +538,12 @@ rule p5statement_control:given {
rule p5statement_control:when {
<sym> <xblock>
}
-rule p5statement_control:default {<sym> <block> }
+rule p5statement_control:default {<sym> <sblock> }
-rule p5statement_prefix:BEGIN {<sym> <block> }
-rule p5statement_prefix:CHECK {<sym> <block> }
-rule p5statement_prefix:INIT {<sym> <block> }
-rule p5statement_control:END {<sym> <block> }
+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 #
@@ -763,7 +733,7 @@ rule routine_def () {
:my $*IN_DECL = 1;
:my $*DECLARAND;
[
- <deflongname>?
+ || <deflongname>
<.newlex(1)>
<parensig>?
<trait>*
@@ -771,6 +741,17 @@ rule routine_def () {
$*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">
@@ -819,8 +800,7 @@ token termish {
[
|| <?{ $*QSIGIL }>
[
- || <?{ $*QSIGIL eq '$' }> [ <POST>+! <?after <[ \] } > ) ]> > ]?
- || <POST>+! <?after <[ \] } > ) ]> >
+ || [ <?before '[' | '{' > <POST> ]*!
|| { $*VAR = 0; }
]
|| <!{ $*QSIGIL }>
@@ -1266,16 +1246,15 @@ token quibble ($l) {
$start <nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ]
- {
- if $lang<_herelang> {
- push @herestub_queue,
- ::Herestub.new(
- delim => $<nibble><nibbles>[0]<TEXT>,
- orignode => $¢,
- lang => $lang<_herelang>,
- );
- }
- }
+ { $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) {
@@ -1306,18 +1285,6 @@ token tribble ($l, $lang2 = $l) {
]
}
-token quasiquibble ($l) {
- :my ($lang, $start, $stop);
- :my $*QUASIMODO = 0; # :COMPILING sets true
- <babble($l)>
- { my $B = $<babble><B>; ($lang,$start,$stop) = @$B; }
-
- [
- || <?{ $start eq '{' }> [ :lang($lang) <block> ]
- || $start [ :lang($lang) <statementlist> ] [$stop || <.panic: "Couldn't find terminator $stop"> ]
- ]
-}
-
# note: polymorphic over many quote languages, we hope
token nibbler {
:my $text = '';
@@ -1380,11 +1347,16 @@ method nibble ($lang) {
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« << » { '<<' \h* ::
+token p5quote:sym« << » { '<<' ::
[
| <?before '"'> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).cursor_herelang)>
| <?before "'"> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q).cursor_herelang)>
- | <.panic: "Non-quoted heredoc not yet implemented">
+ | <identifier>
+ <.queue_heredoc( $<identifier>.Str,
+ $¢.cursor_fresh( %*LANG<Q> ).tweak(:qq).cursor_herelang )>
+ | \\ <identifier>
+ <.queue_heredoc( $<identifier>.Str,
+ $¢.cursor_fresh( %*LANG<Q> ).tweak(:q).cursor_herelang )>
] || <.panic: "Couldn't parse heredoc construct">
}
@@ -1805,7 +1777,7 @@ token p5postcircumfix:sym<[ ]>
{ :dba('subscript') '[' ~ ']' <semilist> <O(|%methodcall)> }
token p5postcircumfix:sym<{ }>
- { :dba('subscript') '{' ~ '}' <semilist> <O(|%methodcall)> }
+ { :dba('subscript') '{' ~ '}' [<identifier><?before '}'>|<semilist>] <O(|%methodcall)> }
token postop {
| <postfix=p5postfix> { $<O> := $<postfix><O>; $<sym> := $<postfix><sym>; }
@@ -1831,7 +1803,6 @@ token semiarglist {
token arglist {
:my $inv_ok = $*INVOCANT_OK;
- :my StrPos $*endargs = 0;
:my $*GOAL ::= 'endargs';
:my $*QSIGIL ::= '';
<.ws>
@@ -1852,10 +1823,15 @@ token arglist {
}
token p5circumfix:sym<{ }> {
- <?before '{' >
+ :: <?before '{' >
<block>
<O(|%term)> }
+token p5statement_control:sym<{ }> {
+ <?before '{' >
+ <sblock>
+<O(|%term)> }
+
## methodcall
token p5postfix:sym['->'] ()
@@ -2179,6 +2155,9 @@ token p5term:uc
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)>? }
@@ -2369,8 +2348,9 @@ token p5term:identifier
{
:my $name;
:my $pos;
- <identifier>
+ <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)>
@@ -2396,11 +2376,12 @@ token p5term:name
{
:my $name;
:my $pos;
- <longname>
+ <longname> ::
{
$name = $<longname>.Str;
$pos = $¢.pos;
}
+ [\h+ <?before '('>]?
<args> # { self.add_mystery($name,$pos,'termish') unless $<args><invocant>; }
<O(|%term)>
}
@@ -2464,7 +2445,6 @@ regex infixstopper {
[
| <?before <stopper> >
| <?before ':' > <?{ $*GOAL eq ':' }>
- | <?{ $*GOAL eq 'endargs' and @*MEMOS[$¢.pos]<endargs> }>
]
}
@@ -2570,7 +2550,15 @@ grammar Regex is STD {
# "normal" metachars
token p5metachar:sym<[ ]> {
- <before '['> <quibble($¢.cursor_fresh( %*LANG<Q> ).tweak(:q))> # XXX parse as q[] for now
+ '[' {} $<neg> = [ '^' ]?
+ $<cclass> = [
+ [
+ [ \\ . || . ]
+ [ '-' [ \\ . || . ]]?
+ ]+?
+ [<?before ']'> || '-' <?before ']'>]
+ ]
+ ']'
}
token p5metachar:sym«(? )» {
21 viv
View
@@ -1411,11 +1411,6 @@ BODY
}
}
-
-{ package VAST::mod_internal__S_ColonBangs; our @ISA = 'VAST::Base';
-}
-
-
{ package VAST::mod_internal__S_Coloni; our @ISA = 'VAST::Base';
sub re_ast { my $self = shift;
$::IGNORECASE = 1;
@@ -1980,6 +1975,13 @@ EOFINAL
sub _tilde { my $self = shift;
my $opener = $self->{atom}->re_ast;
+ my $sigwhite = $self->{sigmaybe}[0];
+ if ($sigwhite) {
+ if (ref($sigwhite) =~ /sigwhite/) {
+ # quantify over sigspace too
+ $opener = RE_sequence->new($opener, $sigwhite->re_ast);
+ }
+ }
my $closer = $self->{quantifier}[0]{quantified_atom}[0]->re_ast;
my $inner = $self->{quantifier}[0]{quantified_atom}[1]->re_ast;
@@ -2772,10 +2774,6 @@ END
}
-{ package VAST::term__S_term; our @ISA = 'VAST::Base';
-}
-
-
{ package VAST::term__S_value; our @ISA = 'VAST::Base';
sub emit_psq { $_[0]{value}->psq}
}
@@ -2818,9 +2816,6 @@ END
-{ package VAST::term; our @ISA = 'VAST::Base';
-}
-
{ package VAST::term__S_name; our @ISA = ('VAST::Base');
sub emit_p5 { my $self = shift;
my @t = $self->SUPER::emit_p5;
@@ -4221,7 +4216,7 @@ END
}
my %psq_map = (
- 'note', => "System.Console.Error.WriteLine"
+ 'note' => "System.Console.Error.WriteLine"
);
sub psq { my $self = shift;
Please sign in to comment.
Something went wrong with that request. Please try again.