Skip to content
Permalink
Browse files

Make regex literals capture $/ and $!

These are then used when the regex is evaluated in boolean context,
rather than using dynamic scope, which is not reliable given that `$_`
is no longer dynamic as of 6.d. Previously, we would not lower away `$_`
if we saw a regex literally present in that scope, however this cannot
handle the at-a-distance uses.

Defining these semantics will, on the upside:

1. Provide the correct behavior for immediate literal uses of /.../,
   which is by far the common case.
2. Provide a good means for `.grep: { /foo/ }` to work (it has always
   been a bit of a "works by accident" before now).
3. Avoid weird issues of finding a `$_` at a distance just because the
   closest one was undefined. In fact, things like `so /foo/` only ever
   worked before now because `so` did not put a defined value into its
   `$_`! Worse still, if you wrote `given $foo { if /.../ { say 1 } }`
   and `$foo` was undefined, you'd not get a warning, but instead it
   would magically match against the first `$_` in dynamic scope that
   has a defiend value!
4. Do nothing but good for performance.

On the downside, it means we have to consider one spectest 6.d errata.
This patch also does not currently retain the previous semantics for
6.c, however I can see how to do that and look into it if there's some
consensus for us to go in this direction.
  • Loading branch information...
jnthn committed Jan 25, 2019
1 parent 7133b81 commit 8ef7c15ed5bff6674270dfe209962aaafd0ac825
Showing with 30 additions and 29 deletions.
  1. +15 −11 src/Perl6/Actions.nqp
  2. +4 −0 src/Perl6/Metamodel/BOOTSTRAP.nqp
  3. +11 −18 src/core/Regex.pm6
@@ -15,14 +15,18 @@ my $abbrev-block := 'abbreviated';
# 2147483648 == 2**31. By adding 1 to it with add_i op, on 32-bit boxes it will overflow
my int $?BITS := nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32;

sub block_closure($code) {
QAST::Op.new( :op('p6capturelex'),
QAST::Op.new(
:op('callmethod'), :name('clone'),
$code)
sub block_closure($code, :$regex) {
my $clone := $regex
?? QAST::Op.new(
:op('callmethod'), :name('clone'), $code,
QAST::Var.new( :name('$_'), :scope('lexical'), :named('topic') ),
QAST::Var.new( :name('$/'), :scope('lexical'), :named('slash') ),
)
!! QAST::Op.new( :op('callmethod'), :name('clone'), $code );
QAST::Op.new( :op('p6capturelex'), $clone ).annotate_self(
'past_block', $code.ann('past_block')
).annotate_self(
'past_block', $code.ann('past_block')
).annotate_self('code_object', $code.ann('code_object'))
'code_object', $code.ann('code_object'))
}

sub wantall($ast, $by) {
@@ -4792,7 +4796,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
}

# Return closure if not in sink context.
make block_closure($coderef).annotate_self(
make block_closure($coderef, :regex).annotate_self(
'sink_ast', QAST::Op.new( :op('null') ))
}

@@ -8485,7 +8489,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
my $coderef := regex_coderef($/, $*W.stub_code_object('Regex'),
$<nibble>.ast, 'anon', '', %sig_info, $block, :use_outer_match(1)) if $<nibble>.ast;
# Return closure if not in sink context.
my $closure := block_closure($coderef);
my $closure := block_closure($coderef, :regex);
$closure.annotate('sink_ast', QAST::Op.new( :op<callmethod>, :name<Bool>, $closure));
make $closure;
}
@@ -8496,7 +8500,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
my %sig_info := hash(parameters => []);
my $coderef := regex_coderef($/, $*W.stub_code_object('Regex'),
$<quibble>.ast, 'anon', '', %sig_info, $block, :use_outer_match(1)) if $<quibble>.ast;
my $past := block_closure($coderef);
my $past := block_closure($coderef, :regex);
$past.annotate('sink_ast', QAST::Op.new(:op<callmethod>, :name<Bool>, $past));
make $past;
}
@@ -8510,7 +8514,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
:node($/),
:op('callmethod'), :name('match'),
WANTED(QAST::Var.new( :name('$_'), :scope('lexical') ),'m'),
block_closure($coderef)
block_closure($coderef, :regex)
);
if self.handle_and_check_adverbs($/, %MATCH_ALLOWED_ADVERBS, 'm', $past) {
# if this match returns a list of matches instead of a single
@@ -3187,11 +3187,15 @@ BEGIN {
# has Mu $!nfa;
# has @!alt_nfas;
# has str $!source;
# has $!topic;
# has $!slash;
Regex.HOW.add_parent(Regex, Method);
Regex.HOW.add_attribute(Regex, scalar_attr('@!caps', List, Regex));
Regex.HOW.add_attribute(Regex, scalar_attr('$!nfa', Mu, Regex));
Regex.HOW.add_attribute(Regex, scalar_attr('%!alt_nfas', Hash, Regex));
Regex.HOW.add_attribute(Regex, scalar_attr('$!source', str, Regex));
Regex.HOW.add_attribute(Regex, scalar_attr('$!topic', Mu, Regex));
Regex.HOW.add_attribute(Regex, scalar_attr('$!slash', Mu, Regex));
Regex.HOW.add_method(Regex, 'SET_CAPS', nqp::getstaticcode(sub ($self, $caps) {
nqp::bindattr(nqp::decont($self), Regex, '@!caps', $caps)
}));
@@ -4,6 +4,8 @@ my class Regex { # declared in BOOTSTRAP
# has Mu $!nfa;
# has %!alt_nfas;
# has str $!source;
# has Mu $!topic;
# has Mu $!slash;

proto method ACCEPTS(|) {*}
multi method ACCEPTS(Regex:D: Mu:U \a) {
@@ -81,24 +83,9 @@ my class Regex { # declared in BOOTSTRAP
}

multi method Bool(Regex:D:) {
nqp::stmts(
(my $ctx := nqp::ctx),
nqp::until(
nqp::isnull($ctx := nqp::ctxcallerskipthunks($ctx))
|| nqp::isconcrete(
my $underscore := nqp::getlexrelcaller($ctx,'$_')
),
nqp::null
),
nqp::if(
nqp::isnull($ctx),
False,
nqp::stmts(
(my $slash := nqp::getlexrelcaller($ctx,'$/')),
($slash = $underscore.match(self)).Bool
)
)
)
nqp::isconcrete($!topic)
?? ($!slash = $!topic.match(self)).Bool
!! False
}

multi method gist(Regex:D:) {
@@ -108,6 +95,12 @@ my class Regex { # declared in BOOTSTRAP
multi method perl(Regex:D:) {
nqp::ifnull($!source,'')
}

method clone(Mu :$topic is raw, Mu :$slash is raw --> Regex) {
nqp::p6bindattrinvres(
nqp::p6bindattrinvres(self.Method::clone, Regex, '$!topic', $topic),
Regex, '$!slash', $slash)
}
}

multi sub infix:<~~>(Mu \topic, Regex:D \matcher) {

0 comments on commit 8ef7c15

Please sign in to comment.
You can’t perform that action at this time.