-
-
Save FROGGS/9307c7681cfb9ff34de0 to your computer and use it in GitHub Desktop.
contextualizer $( ... )
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
rakudo$ make -j4 && ./perl6 -e '$( 1 )' | |
term:sym<value>(1) | |
circumfix:sym<sigil>($( 1 )) | |
rakudo$ make -j4 && ./perl6 -e '"$( 1 )"' | |
term:sym<value>(1) | |
circumfix:sym<sigil>($( 1 )) | |
escape:sym<$>($( 1 )) | |
term:sym<value>("$( 1 )") | |
rakudo$ make -j4 && ./perl6 -e '/$( 1 )/' | |
term:sym<value>(1) | |
arglist(1 ) | |
arglist(1 ) else: QAST::WVal<4299402192258411389> | |
postcircumfix:sym<( )>(( 1 )) | |
variable($( 1 )) | |
variable($( 1 )) postcircumfix | |
metachar:sym<var>($( 1 )) | |
term:sym<value>(/$( 1 )/) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm | |
index bc9974e..1611f75 100644 | |
--- a/src/Perl6/Actions.pm | |
+++ b/src/Perl6/Actions.pm | |
@@ -1234,6 +1234,7 @@ class Perl6::Actions is HLL::Actions does STDActions { | |
} | |
method variable($/) { | |
+ print("variable(" ~ ~$/ ~ ")\n"); | |
my $past; | |
if $<index> { | |
$past := QAST::Op.new( | |
@@ -3803,6 +3804,7 @@ class Perl6::Actions is HLL::Actions does STDActions { | |
} | |
method semiarglist($/) { | |
+ print("semiarglist(" ~ ~$/ ~ ")\n"); | |
if +$<arglist> == 1 { | |
make $<arglist>[0].ast; | |
} | |
@@ -3818,6 +3820,7 @@ class Perl6::Actions is HLL::Actions does STDActions { | |
} | |
method arglist($/) { | |
+ print("arglist(" ~ ~$/ ~ ")\n"); | |
my $Pair := $*W.find_symbol(['Pair']); | |
my $past := QAST::Op.new( :op('call'), :node($/) ); | |
if $<EXPR> { | |
@@ -3871,7 +3874,10 @@ class Perl6::Actions is HLL::Actions does STDActions { | |
make $past; | |
} | |
- method term:sym<value>($/) { make $<value>.ast; } | |
+ method term:sym<value>($/) { | |
+ print("term:sym<value>(" ~ ~$/ ~ ")\n"); | |
+ make $<value>.ast; | |
+ } | |
method circumfix:sym<( )>($/) { | |
my $past := $<semilist>.ast; | |
@@ -4716,6 +4722,7 @@ class Perl6::Actions is HLL::Actions does STDActions { | |
} | |
method postcircumfix:sym<( )>($/) { | |
+ print("postcircumfix:sym<( )>(" ~ ~$/ ~ "\n"); | |
make $<arglist>.ast; | |
} | |
@@ -5802,6 +5809,7 @@ class Perl6::QActions is HLL::Actions does STDActions { | |
method backslash:sym<0>($/) { make "\c[0]" } | |
method escape:sym<{ }>($/) { | |
+ print("escape:sym<\{ }>(" ~ ~$/ ~")\n"); | |
make QAST::Op.new( | |
:op('callmethod'), :name('Stringy'), | |
QAST::Op.new( | |
@@ -5810,7 +5818,10 @@ class Perl6::QActions is HLL::Actions does STDActions { | |
:node($/))); | |
} | |
- method escape:sym<$>($/) { make $<EXPR>.ast; } | |
+ method escape:sym<$>($/) { | |
+ print("escape:sym<\$>(" ~ ~$/ ~")\n"); | |
+ make $<EXPR>.ast; | |
+ } | |
method escape:sym<@>($/) { make $<EXPR>.ast; } | |
method escape:sym<%>($/) { make $<EXPR>.ast; } | |
method escape:sym<&>($/) { make $<EXPR>.ast; } | |
@@ -5832,6 +5843,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { | |
} | |
method metachar:sym<{ }>($/) { | |
+ print("metachar:sym<\{ }>(" ~ ~$/ ~ ")\n"); | |
make QAST::Regex.new( $<codeblock>.ast, | |
:rxtype<qastnode>, :node($/) ); | |
} | |
@@ -5868,15 +5880,67 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { | |
} | |
} | |
+ # Can't call it sym<var> like in STD, cause this will override NQP's token | |
method metachar:sym<rakvar>($/) { | |
- make QAST::Regex.new( QAST::Node.new( | |
- QAST::SVal.new( :value('INTERPOLATE') ), | |
- $<var>.ast, | |
- QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ) ), | |
- :rxtype<subrule>, :subtype<method>, :node($/)); | |
+ print("metachar:sym<var>(" ~ ~$/ ~ ")\n"); | |
+ if 1 { | |
+ make QAST::Regex.new( QAST::Node.new( | |
+ QAST::SVal.new( :value('!LITERAL') ), | |
+ $<variable>.ast, | |
+ QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ) ), | |
+ :rxtype<subrule>, :subtype<method>, :node($/)); | |
+ } | |
+ else { | |
+ # blockoid | |
+ # my $past := $<variable>.ast; | |
+ # if %*HANDLERS { | |
+ # $past := QAST::Op.new( :op('handle'), $past ); | |
+ # for %*HANDLERS { | |
+ # $past.push($_.key); | |
+ # $past.push($_.value); | |
+ # } | |
+ # } | |
+ # my $block := $*CURPAD; | |
+ # $block.push($past); | |
+ # $block.node($/); | |
+ # $block<statementlist> := $<variable>.ast; | |
+ # $block<handlers> := %*HANDLERS if %*HANDLERS; | |
+ | |
+ my $block := $<variable>.ast; | |
+ | |
+ # block | |
+ ($*W.cur_lexpad())[0].push(my $uninst := QAST::Stmts.new($block)); | |
+ $*W.attach_signature($*DECLARAND, $*W.create_signature(nqp::hash('parameters', []))); | |
+ $*W.finish_code_object($*DECLARAND, $block); | |
+ my $ref := reference_to_code_object($*DECLARAND, $block); | |
+ $ref<uninstall_if_immediately_used> := $uninst; | |
+ | |
+ # codeblock | |
+ my $qast := QAST::Stmts.new( | |
+ QAST::Op.new( | |
+ :op('p6store'), | |
+ QAST::Var.new( :name('$/'), :scope<lexical> ), | |
+ QAST::Op.new( | |
+ QAST::Var.new( :name('$¢'), :scope<lexical> ), | |
+ :name('MATCH'), | |
+ :op('callmethod') | |
+ ) | |
+ ), | |
+ QAST::Op.new(:op<call>, $ref) # codeblock | |
+ ); | |
+ # assertion | |
+ $qast := QAST::Regex.new( | |
+ QAST::Node.new( | |
+ QAST::SVal.new( :value('INTERPOLATE') ), | |
+ QAST::Op.new( | |
+ :op<call>, :name<&MAKE_REGEX>, $qast ) ), | |
+ :rxtype<subrule>, :subtype<method>, :node($/)); | |
+ make $qast; | |
+ } | |
} | |
method assertion:sym<{ }>($/) { | |
+ print("assertion:sym<\{ }>(" ~ ~$/ ~ ")\n"); | |
make QAST::Regex.new( | |
QAST::Node.new( | |
QAST::SVal.new( :value('INTERPOLATE') ), | |
@@ -5886,20 +5950,24 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { | |
} | |
method assertion:sym<?{ }>($/) { | |
+ print("assertion:sym<?\{ }>(" ~ ~$/ ~ ")\n"); | |
make QAST::Regex.new( $<codeblock>.ast, | |
:subtype<zerowidth>, :negate( $<zw> eq '!' ), | |
:rxtype<qastnode>, :node($/) ); | |
} | |
- method assertion:sym<var>($/) { | |
+ method assertion:sym<variable>($/) { | |
+ print("assertion:sym<variable>(" ~ ~$/ ~ ")\n"); | |
make QAST::Regex.new( | |
QAST::Node.new( | |
QAST::SVal.new( :value('INTERPOLATE') ), | |
- QAST::Op.new( :op<call>, :name<&MAKE_REGEX>, $<var>.ast ) ), | |
+ QAST::Op.new( :op<call>, :name<&MAKE_REGEX>, $<variable>.ast ) ), | |
:rxtype<subrule>, :subtype<method>, :node($/)); | |
} | |
method assertion:sym<name>($/) { | |
+ print("assertion:sym<name>(" ~ ~$/ ~ ")\n"); | |
+ print("assertion:sym<name>(" ~ ~$<longname> ~ ")\n"); | |
my @parts := $*W.disect_longname($<longname>).components(); | |
my $name := @parts.pop(); | |
my $qast; | |
diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm | |
index ee7d73a..468fd93 100644 | |
--- a/src/Perl6/Grammar.pm | |
+++ b/src/Perl6/Grammar.pm | |
@@ -1620,7 +1620,10 @@ grammar Perl6::Grammar is HLL::Grammar does STD { | |
| <sigil> <twigil>? <desigilname> | |
| <special_variable> | |
| <sigil> $<index>=[\d+] [ <?{ $*IN_DECL}> <.typed_panic: "X::Syntax::Variable::Numeric">]? | |
- | <sigil> <?[<[]> [ <?{ $*IN_DECL }> <.typed_panic('X::Syntax::Variable::Match')>]? <postcircumfix> | |
+ # Note: $() can also parse as contextualizer in an expression; should have same effect | |
+ | <sigil> <?[<]> [ <?{ $*IN_DECL }> <.typed_panic('X::Syntax::Variable::Match')>]? <postcircumfix> | |
+# | <sigil> <?before '<'> [<?{ $*IN_DECL }> <.typed_panic('X::Syntax::Variable::Match')>]? <postcircumfix> | |
+ | <sigil> <?before '('> [<?{ $*IN_DECL }> <.panic: "Cannot declare a contextualizer">]? <postcircumfix> | |
| $<sigil>=['$'] $<desigilname>=[<[/_!]>] | |
| <sigil> <?{ $*IN_DECL }> | |
| <!{ $*QSIGIL }> <.typed_panic: 'X::Syntax::SigilWithoutName'> | |
@@ -2538,6 +2541,27 @@ grammar Perl6::Grammar is HLL::Grammar does STD { | |
| <?> | |
] | |
} | |
+# token arglist { | |
+# :my $inv_ok = $*INVOCANT_OK; | |
+# :my StrPos $*endargs = 0; | |
+# :my $*GOAL ::= 'endargs'; | |
+# :my $*QSIGIL ::= ''; | |
+# <.ws> | |
+# :dba('argument list') | |
+# [ | |
+# | <?stdstopper> | |
+# | <EXPR(item %list_prefix)> { | |
+# my $delims = $<EXPR><delims>; | |
+# for @$delims { | |
+# if $_.<infix><wascolon> // '' { | |
+# if $inv_ok { | |
+# $*INVOCANT_IS = $<EXPR><list>[0]; | |
+# } | |
+# } | |
+# } | |
+# } | |
+# ] | |
+# } | |
proto token value { <...> } | |
token value:sym<quote> { <quote> } | |
@@ -3760,9 +3784,22 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar does STD { | |
<?[{]> <codeblock> | |
} | |
+ # Can't call it sym<var> like in STD, cause this will override NQP's token | |
+# token metachar:sym<variable> { | |
+# <?before <[$@&]> [<alpha> | \W<alpha>]> <variable=.LANG('MAIN', 'variable')> | |
+# { self.check_variable($<variable>) } | |
+# } | |
token metachar:sym<rakvar> { | |
- <?before <[$@&]> [<alpha> | \W<alpha>]> <var=.LANG('MAIN', 'variable')> | |
- { self.check_variable($<var>) } | |
+ :my $*QSIGIL := nqp::substr(self.orig,self.pos,1); | |
+ <?before <sigil> [<alpha> | $<twigil>=[\W] <alpha> | '(']> | |
+ <variable=.LANG('MAIN','variable')> | |
+ $<sym> = {$<variable>.Str} | |
+ [ | |
+ || $<binding> = ( \s* '=' \s* <quantified_atom> ) | |
+ { self.check_variable($<variable>) unless $<twigil> eq '<' } | |
+ || { self.check_variable($<variable>) } | |
+ [ <?before '.'? <[ \[ \{ \< ]>> <.panic: "Apparent subscript will be treated as regex"> ]? | |
+ ] | |
} | |
token metachar:sym<qw> { | |
@@ -3782,8 +3819,8 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar does STD { | |
$<zw>=[ <[?!]> <?before '{'> ] <codeblock> | |
} | |
- token assertion:sym<var> { | |
- <?[$@&]> <var=.LANG('MAIN', 'variable')> | |
+ token assertion:sym<variable> { | |
+ <?before <[$@&]>> <variable=.LANG('MAIN', 'variable')> | |
} | |
token assertion:sym<~~> { | |
@@ -3800,14 +3837,30 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar does STD { | |
<arglist=.LANG('MAIN','arglist')> | |
} | |
+# token assertion:sym<name> { | |
+# <longname=.LANG('MAIN','longname')> | |
+# [ | |
+# | <?before '>'> | |
+# | '=' <assertion> | |
+# | ':' <arglist> | |
+# | '(' <arglist> ')' | |
+# | <.normspace> <nibbler> | |
+# ]? | |
+# } | |
token assertion:sym<name> { | |
<longname=.LANG('MAIN','longname')> | |
[ | |
- | <?before '>'> | |
+ | <?before '>'> { | |
+ my $n := $<longname>.Str; | |
+ if $n eq 'before' || $n eq 'after' { | |
+ self.panic("$n requires an argument"); | |
+ } | |
+ } | |
+ | <.normspace>? <nibbler> <.ws> | |
| '=' <assertion> | |
| ':' <arglist> | |
- | '(' <arglist> ')' | |
- | <.normspace> <nibbler> | |
+ | '(' {} <arglist> | |
+ [ ')' || <.panic: "Assertion call missing right parenthesis"> ] | |
]? | |
} | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
rakudo$ make -j4 && ./perl6 -e 'say "1" ~~ /$( "a" )/' | |
term:sym<value>("1") | |
term:sym<value>("a") | |
arglist("a" ) | |
postcircumfix:sym<( )>(( "a" ) | |
variable($( "a" )) | |
metachar:sym<var>($( "a" )) | |
term:sym<value>(/$( "a" )/) | |
arglist("1" ~~ /$( "a" )/) | |
No such method 'Any' for invocant of type 'Str' | |
in at src/gen/BOOTSTRAP.pm:839 | |
in any at src/gen/BOOTSTRAP.pm:836 | |
in regex at -e:1 | |
in method ACCEPTS at src/gen/CORE.setting:10733 | |
in block at -e:1 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
rakudo$ ./perl6 --target=past -e '/$(1)/' | |
term:sym<value>(1) | |
arglist(1) | |
postcircumfix:sym<( )>((1) | |
variable($(1)) | |
metachar:sym<var>($(1)) | |
term:sym<value>(/$(1)/) | |
- QAST::CompUnit | |
- QAST::Block /$(1)/ | |
- QAST::Stmts | |
- QAST::Op(call) | |
- QAST::Block | |
- QAST::Stmts | |
- QAST::Var(lexical GLOBALish) | |
- QAST::Var(lexical EXPORT) | |
- QAST::Var(lexical $?PACKAGE) | |
- QAST::Var(lexical ::?PACKAGE) | |
- QAST::Var(lexical $_) | |
- QAST::Var(lexical $/) | |
- QAST::Var(lexical $!) | |
- QAST::Block /$(1)/ | |
- QAST::Stmts | |
- QAST::Op(p6takedisp) | |
- QAST::Var(lexical self) | |
- QAST::Var(lexical %_) | |
- QAST::Var(lexical $¢) | |
- QAST::Op(bind) | |
- QAST::Var(lexical $?REGEX) | |
- QAST::Op(p6vmcodetoobj) | |
- QAST::Op(curcode) | |
- QAST::Op(bind) | |
- QAST::Var(lexical call_sig) | |
- QAST::Op(p6getcallsig) | |
- QAST::Op(p6bindsig) | |
- QAST::Var(lexical $*DISPATCHER) | |
- QAST::Op(bind) | |
- QAST::Var(local self) | |
- QAST::Var(lexical self) | |
- QAST::Stmts | |
- QAST::Regex | |
- QAST::Regex | |
- QAST::Regex $(1) | |
- QAST::Regex $(1) | |
- QAST::Node | |
- QAST::SVal(!LITERAL) | |
- QAST::Op(call) 1 | |
- QAST::Var(lexical $/) | |
- QAST::Want | |
- QAST::WVal(Int) | |
- Ii | |
- QAST::IVal(1) | |
- QAST::IVal(0) | |
- QAST::Regex | |
- QAST::Var(lexical $=pod) | |
- QAST::Var(lexical !UNIT_MARKER) | |
- QAST::VM | |
- QAST::Stmt | |
- QAST::Op(bind) | |
- QAST::Var(local ctxsave) | |
- QAST::Var(contextual $*CTXSAVE) | |
- QAST::Op(unless) | |
- QAST::Op(isnull) | |
- QAST::Var(local ctxsave) | |
- QAST::Op(if) | |
- QAST::Op(can) | |
- QAST::Var(local ctxsave) | |
- QAST::SVal(ctxsave) | |
- QAST::Op(callmethod ctxsave) | |
- QAST::Var(local ctxsave) | |
- QAST::Stmts | |
- QAST::WVal(Array) | |
- QAST::Stmts /$(1)/ | |
- QAST::Want | |
- QAST::Op(p6capturelex) | |
- QAST::Op(callmethod clone) | |
- QAST::WVal(Regex) | |
- v | |
- QAST::Op(null) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
std$ ./viv -e '/$(1)/' | |
VAST::comp_unit, BEG: 0, END: 7 | |
│ └─LEX: !!perl/hash:Stash | |
│ '!file': &1 | |
│ name: (eval) | |
│ '!id': | |
│ - MY:file<(eval)> | |
│ '!line': 0 | |
│ $!: !!perl/hash:NAME | |
│ dynamic: 1 | |
│ file: *1 | |
│ line: 1 | |
│ name: $! | |
│ scope: my | |
│ $/: !!perl/hash:NAME | |
│ dynamic: 1 | |
│ file: *1 | |
│ line: 1 | |
│ name: $/ | |
│ scope: my | |
│ $_: !!perl/hash:NAME | |
│ dynamic: 1 | |
│ file: *1 | |
│ line: 1 | |
│ name: $_ | |
│ scope: my | |
│ 'OUTER::': | |
│ - MY:file<CORE.setting>:line(676):pos(19754) | |
└─VAST::statementlist, BEG: 0, END: 7 | |
├─VAST::statement, BEG: 0, END: 7 | |
│ └─VAST::term__S_value, BEG: 0, END: 6, SYM: value, _specific: 1 | |
│ └─VAST::value__S_quote, BEG: 0, END: 6, SYM: quote, _specific: 1 | |
│ └─VAST::quote__S_Slash_Slash, BEG: 0, END: 6, SYM: / /, _specific: 1 | |
│ └─VAST::nibbler, BEG: 1, END: 5 | |
│ └─VAST::quant_atom_list, BEG: 1, END: 5 | |
│ └─VAST::quantified_atom, BEG: 1, END: 5 | |
│ ├─VAST::atom, BEG: 1, END: 5 | |
│ │ └─VAST::metachar__S_var, BEG: 1, END: 5, SYM: $(1), | |
│ │ │ │ _specific: 1 | |
│ │ │ └─sigil: VAST::sigil__S_Dollar, BEG: 1, END: 2, SYM: $, TEXT: $, | |
│ │ │ _specific: 1 | |
│ │ └─VAST::variable, BEG: 1, END: 5 | |
│ │ ├─VAST::sigil__S_Dollar, BEG: 1, END: 2, SYM: $, TEXT: $, | |
│ │ │ _specific: 1 | |
│ │ └─VAST::SYM_postcircumfix__S_Paren_Thesis, BEG: 2, | |
│ │ │ │ END: 5, SYM: ( ), _from: 5, _pos: 5, _specific: 1, | |
│ │ │ │ assoc: unary, dba: methodcall, fiddly: 1, prec: y=, | |
│ │ │ │ pure: 0, uassoc: left | |
│ │ │ └─_op: VAST::postcircumfix__S_Paren_Thesis | |
│ │ └─VAST::semiarglist, BEG: 3, END: 4 | |
│ │ └─VAST::arglist, BEG: 3, END: 4 | |
│ │ └─VAST::term__S_value, BEG: 3, END: 4, SYM: value, | |
│ │ │ _specific: 1 | |
│ │ └─VAST::value__S_number, BEG: 3, END: 4, | |
│ │ │ SYM: number, _specific: 1 | |
│ │ └─VAST::number, BEG: 3, END: 4 | |
│ │ └─VAST::integer, BEG: 3, END: 4 | |
│ │ └─VAST::decint, BEG: 3, END: 4, TEXT: 1 | |
│ └─VAST::sigmaybe__S_nosp, BEG: 5, END: 5, SYM: nosp, TEXT: , | |
│ _specific: 1 | |
└─VAST::eat_terminator, BEG: 7, END: 7, TEXT: , WS: 1 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment