Permalink
Browse files

allow to run code in P5 regexes

  • Loading branch information...
1 parent 94b7b28 commit da63d0841bba31dda1b2b518f87e1e24b72c5f15 @FROGGS FROGGS committed Aug 19, 2013
Showing with 46 additions and 0 deletions.
  1. +34 −0 src/Perl6/Actions.nqp
  2. +12 −0 src/Perl6/Grammar.nqp
View
@@ -6396,6 +6396,40 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions {
$*W.create_signature(nqp::hash('parameters', [])))
}
+ method p5metachar:sym<(?{ })>($/) {
+ make QAST::Regex.new( $<codeblock>.ast,
+ :rxtype<qastnode>, :node($/) );
+ }
+
+ method p5metachar:sym<(??{ })>($/) {
+ make QAST::Regex.new(
+ QAST::Node.new(
+ QAST::SVal.new( :value('INTERPOLATE') ),
+ $<codeblock>.ast,
+ QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ),
+ QAST::IVal.new( :value(1) ),
+ QAST::IVal.new( :value(1) ) ),
+ :rxtype<subrule>, :subtype<method>, :node($/));
+ }
+
+ method codeblock($/) {
+ my $blockref := $<block>.ast;
+ my $past :=
+ 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>, $blockref)
+ );
+ make $past;
+ }
+
method store_regex_nfa($code_obj, $block, $nfa) {
$code_obj.SET_NFA($nfa.save);
}
View
@@ -4053,4 +4053,16 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar does STD {
grammar Perl6::P5RegexGrammar is QRegex::P5Regex::Grammar does STD {
token rxstopper { <stopper> }
+
+ token p5metachar:sym<(?{ })> {
+ '(?' <?[{]> <codeblock> ')'
+ }
+
+ token p5metachar:sym<(??{ })> {
+ '(??' <?[{]> <codeblock> ')'
+ }
+
+ token codeblock {
+ <block=.LANG('MAIN','block')>
+ }
}

0 comments on commit da63d08

Please sign in to comment.