Made smartmatching with something other than a regex on the RHS retur…

…n a Bool.
rakudo · Jan 14, 2011 · 7fd3dea · 7fd3dea
1 parent a350ff4
commit 7fd3dea
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 15 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -2402,7 +2402,7 @@ sub make_smartmatch($/, $negated) {
     my $rhs := $/[1].ast;
     my $old_topic_var := $lhs.unique('old_topic');
     my $result_var := $lhs.unique('sm_result');
-    my $past := PAST::Op.new(
+    PAST::Op.new(
         :pasttype('stmts'),
 
         # Stash original $_.
@@ -2421,9 +2421,12 @@ sub make_smartmatch($/, $negated) {
         # return value to a result variable.
         PAST::Op.new( :pasttype('bind'),
             PAST::Var.new( :name($result_var), :scope('lexical'), :isdecl(1) ),
-            PAST::Op.new( :pasttype('callmethod'), :name('ACCEPTS'),
-                $rhs,
-                PAST::Var.new( :name('$_'), :scope('lexical') )
+            PAST::Op.new( :pasttype('call'), :name('&coerce-smartmatch-result'),
+                PAST::Op.new( :pasttype('callmethod'), :name('ACCEPTS'),
+                    $rhs,
+                    PAST::Var.new( :name('$_'), :scope('lexical') )
+                ),
+                $negated
             )
         ),
 
@@ -2436,14 +2439,6 @@ sub make_smartmatch($/, $negated) {
         # And finally evaluate to the smart-match result.
         PAST::Var.new( :name($result_var), :scope('lexical') )
     );
-    if $negated {
-        $past := PAST::Op.new(
-            :pasttype('call'),
-            :name('&prefix:<!>'),
-            $past
-        );
-    }
-    $past;
 }
 
 method prefixish($/) {

diff --git a/src/core/Any-list.pm b/src/core/Any-list.pm
@@ -214,10 +214,10 @@ augment class Any {
         self.roll(Inf);
     }
 
-    multi method classify($test) {
+    multi method classify(&test) {
         my %result;
         for @.list {
-            my $k = $_ ~~ $test;
+            my $k = test $_;
             %result{$k} //= [];
             %result{$k}.push: $_;
         }

diff --git a/src/core/Match.pm b/src/core/Match.pm
@@ -210,4 +210,11 @@ multi sub infix:<eqv>(Match $a, Match $b) {
     && $a.hash eqv $b.hash
 }
 
+# A helper function used by Perl6/Actions.pm. The real point is to
+# ensure that Parrot objects returned by .ACCEPTS are converted to
+# Bools.
+our multi coerce-smartmatch-result($x,       1) { ! $x }
+our multi coerce-smartmatch-result(Mu $x,    0) { ? $x }
+our multi coerce-smartmatch-result(Match $x, 0) {   $x }
+
 # vim: ft=perl6
diff --git a/src/core/operators.pm b/src/core/operators.pm
@@ -1,5 +1,5 @@
 our multi infix:<~~>(Mu $topic, Mu $matcher) {
-    $matcher.ACCEPTS($topic)
+    ? $matcher.ACCEPTS($topic)
 }
 
 our multi infix:<~~>(Mu $topic, Regex $matcher) {