Skip to content

Instantly share code, notes, and snippets.

@FROGGS

FROGGS/compare_Code_Q_Regex.txt Secret

Last active December 11, 2015 20:39
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save FROGGS/9307c7681cfb9ff34de0 to your computer and use it in GitHub Desktop.
Save FROGGS/9307c7681cfb9ff34de0 to your computer and use it in GitHub Desktop.
Download ZIP
contextualizer $( ... )
Raw
compare_Code_Q_Regex.txt
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 )/)
Raw
diff.patch
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"> ]
]?
}
}
Raw
nom_dbg.txt
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
Raw
qast_dump.txt
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)
Raw
std_viv.txt
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