Initial version of smartmatch operator.

perl6 · Dec 3, 2009 · 2f65563 · 2f65563
1 parent 2d32e30
commit 2f65563
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 0 deletions.
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
@@ -718,6 +718,10 @@ method prefix:sym<make>($/) {
     );
 }
 
+method infix:sym<~~>($/) {
+    make PAST::Op.new( :pasttype<callmethod>, :name<ACCEPTS>, :node($/) );
+}
+
 
 class NQP::RegexActions is Regex::P6Regex::Actions {
 

diff --git a/src/NQP/Grammar.pm b/src/NQP/Grammar.pm
@@ -480,6 +480,7 @@ token infix:sym«ge»   { <sym>  <O('%relational, :pirop<isge ISs>')> }
 token infix:sym«lt»   { <sym>  <O('%relational, :pirop<islt ISs>')> }
 token infix:sym«gt»   { <sym>  <O('%relational, :pirop<isgt ISs>')> }
 token infix:sym«=:=»  { <sym>  <O('%relational, :pirop<issame>')> }
+token infix:sym<~~>   { <sym>  <O('%relational, :reducecheck<smartmatch>')> }
 
 token infix:sym<&&>   { <sym>  <O('%tight_and, :pasttype<if>')> }
 
@@ -505,6 +506,11 @@ token infix:sym<,>    { <sym>  <O('%comma, :pasttype<list>')> }
 token prefix:sym<return> { <sym> \s <O('%list_prefix, :pasttype<return>')> }
 token prefix:sym<make>   { <sym> \s <O('%list_prefix')> }
 
+method smartmatch($/) {
+    # swap rhs into invocant position
+    my $t := $/[0]; $/[0] := $/[1]; $/[1] := $t;
+}
+
 
 grammar NQP::Regex is Regex::P6Regex::Grammar {
     token metachar:sym<:my> {

diff --git a/t/nqp/45-smartmatch.t b/t/nqp/45-smartmatch.t
@@ -0,0 +1,12 @@
+#! nqp
+
+P6metaclass.register('Integer');
+P6metaclass.register('ResizablePMCArray');
+
+plan(4);
+ok(3 ~~ Integer, "smartmatch of Integer works");
+ok(!(4.5 ~~ Integer), "negative smartmatch of Integer works");
+
+ok(<a b c> ~~ ResizablePMCArray, "smartmatch of RPA works");
+ok(!(3 ~~ ResizablePMCArray), "negative smartmatch of RPA works");
+