allow ~~ to chain where practical

(A regex or closure must be at the end of the chain, however.)
rakudo · Dec 10, 2015 · f457007 · f457007
1 parent 06ed575
commit f457007
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 0 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -5890,6 +5890,14 @@ Compilation unit '$file' contained the following violations:
         # autoprime only on Whatever with explicit *
         return 0 if $lhs ~~ QAST::WVal && istype($lhs.returns, $*W.find_symbol(['Whatever'])) && nqp::isconcrete($lhs.value);
         return 0 if $rhs ~~ QAST::WVal && istype($rhs.returns, $*W.find_symbol(['Whatever'])) && nqp::isconcrete($rhs.value);
+
+        # don't need topicalization, so allow chaining?
+        return 0 if !$*COMPILING_CORE_SETTING && (
+            $rhs.has_compile_time_value ||
+            nqp::istype($rhs,QAST::Var) ||
+            nqp::istype($lhs,QAST::Op) && $lhs.op eq 'chain'
+        );
+
         my $old_topic_var := $lhs.unique('old_topic');
         my $result_var := $lhs.unique('sm_result');
         my $sm_call;

diff --git a/src/core/Mu.pm b/src/core/Mu.pm
@@ -702,6 +702,11 @@ multi sub infix:<~~>(Mu \topic, Mu \matcher) {
     matcher.ACCEPTS(topic).Bool;
 }
 
+proto sub infix:<!~~>(Mu \topic, Mu \matcher) { * }
+multi sub infix:<!~~>(Mu \topic, Mu \matcher) {
+    matcher.ACCEPTS(topic).not;
+}
+
 proto sub infix:<=:=>(Mu $?, Mu $?) is pure { * }
 multi sub infix:<=:=>($?)      { Bool::True }
 multi sub infix:<=:=>(Mu \a, Mu \b) {