Skip to content
Permalink
Browse files

Preserve 6.c Regex.Bool behavior

  • Loading branch information...
jnthn committed Jan 28, 2019
1 parent 8ef7c15 commit 3d581c8d23e0b47fd09616a1165f84568531a4aa
Showing with 41 additions and 10 deletions.
  1. +11 −7 src/Perl6/Actions.nqp
  2. +3 −0 src/core/Rakudo/Internals.pm6
  3. +27 −3 src/core/Regex.pm6
@@ -16,13 +16,17 @@ my $abbrev-block := 'abbreviated';
my int $?BITS := nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32;

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 );
my $clone := QAST::Op.new( :op('callmethod'), :name('clone'), $code );
if $regex {
if $*W.lang-ver-before('d') {
my $marker := $*W.find_symbol(['Rakudo', 'Internals', 'RegexBoolification6cMarker']);
$clone.push(QAST::WVal.new( :value($marker), :named('topic') ));
}
else {
$clone.push(QAST::Var.new( :name('$_'), :scope('lexical'), :named('topic') ));
$clone.push(QAST::Var.new( :name('$/'), :scope('lexical'), :named('slash') ));
}
}
QAST::Op.new( :op('p6capturelex'), $clone ).annotate_self(
'past_block', $code.ann('past_block')
).annotate_self(
@@ -41,6 +41,9 @@ my class Rakudo::Internals {
method dynamic() { False }
}

# Marker symbol for 6.c-mode regex boolification.
class RegexBoolification6cMarker { }

# rotate nqp list to another given list without using push/pop
method RotateListToList(\from,\n,\to) {
nqp::stmts(
@@ -83,9 +83,33 @@ my class Regex { # declared in BOOTSTRAP
}

multi method Bool(Regex:D:) {
nqp::isconcrete($!topic)
?? ($!slash = $!topic.match(self)).Bool
!! False
my Mu \topic = $!topic;
nqp::istype_nd(topic, Rakudo::Internals::RegexBoolification6cMarker)
?? self!Bool6c()
!! nqp::isconcrete(topic)
?? ($!slash = topic.match(self)).Bool
!! False
}

method !Bool6c() {
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
)
)
)
}

multi method gist(Regex:D:) {

0 comments on commit 3d581c8

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