From 9ac064cd621e6f950efc7a9f77999df0322e4393 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 9 Jul 2011 01:09:26 -0500
Subject: make the pure perl version a bit faster

---
 lib/smartmatch/engine/core.pm | 47 +++++++++++++++++++++++--------------------
 1 file changed, 25 insertions(+), 22 deletions(-)

(limited to 'lib/smartmatch')

diff --git a/lib/smartmatch/engine/core.pm b/lib/smartmatch/engine/core.pm
index 0cb7cd0..40a3d06 100644
--- a/lib/smartmatch/engine/core.pm
+++ b/lib/smartmatch/engine/core.pm
@@ -89,10 +89,13 @@ sub type {
 sub match {
     my ($a, $b, $seen) = @_;
 
-    if (type($b) eq 'undef') {
+    my $type_a = type($a);
+    my $type_b = type($b);
+
+    if ($type_b eq 'undef') {
         return !defined($a);
     }
-    elsif (type($b) eq 'Object') {
+    elsif ($type_b eq 'Object') {
         my $overload = overload::Method($b, '~~');
 
         # XXX this is buggy behavior and may be changed
@@ -107,19 +110,19 @@ sub match {
             unless $overload;
         return $b->$overload($a, 1);
     }
-    elsif (type($b) eq 'CodeRef') {
-        if (type($a) eq 'Hash') {
+    elsif ($type_b eq 'CodeRef') {
+        if ($type_a eq 'Hash') {
             return !grep { !$b->($_) } keys %$a;
         }
-        elsif (type($a) eq 'Array') {
+        elsif ($type_a eq 'Array') {
             return !grep { !$b->($_) } @$a;
         }
         else {
             return $b->($a);
         }
     }
-    elsif (type($b) eq 'Hash') {
-        if (type($a) eq 'Hash') {
+    elsif ($type_b eq 'Hash') {
+        if ($type_a eq 'Hash') {
             my @a = sort keys %$a;
             my @b = sort keys %$b;
             return unless @a == @b;
@@ -128,24 +131,24 @@ sub match {
             }
             return 1;
         }
-        elsif (type($a) eq 'Array') {
+        elsif ($type_a eq 'Array') {
             return grep { exists $b->{$_ // ''} } @$a;
         }
-        elsif (type($a) eq 'Regex') {
+        elsif ($type_a eq 'Regex') {
             return grep /$a/, keys %$b;
         }
-        elsif (type($a) eq 'undef') {
+        elsif ($type_a eq 'undef') {
             return;
         }
         else {
             return exists $b->{$a};
         }
     }
-    elsif (type($b) eq 'Array') {
-        if (type($a) eq 'Hash') {
+    elsif ($type_b eq 'Array') {
+        if ($type_a eq 'Hash') {
             return grep { exists $a->{$_ // ''} } @$b;
         }
-        elsif (type($a) eq 'Array') {
+        elsif ($type_a eq 'Array') {
             return unless @$a == @$b;
             if (!$seen) {
                 $seen = {};
@@ -159,10 +162,10 @@ sub match {
             }
             return 1;
         }
-        elsif (type($a) eq 'Regex') {
+        elsif ($type_a eq 'Regex') {
             return grep /$a/, @$b;
         }
-        elsif (type($a) eq 'undef') {
+        elsif ($type_a eq 'undef') {
             return grep !defined, @$b;
         }
         else {
@@ -178,32 +181,32 @@ sub match {
             } @$b;
         }
     }
-    elsif (type($b) eq 'Regex') {
-        if (type($a) eq 'Hash') {
+    elsif ($type_b eq 'Regex') {
+        if ($type_a eq 'Hash') {
             return grep /$b/, keys %$a;
         }
-        elsif (type($a) eq 'Array') {
+        elsif ($type_a eq 'Array') {
             return grep /$b/, @$a;
         }
         else {
             return $a =~ $b;
         }
     }
-    elsif (type($a) eq 'Object') {
+    elsif ($type_a eq 'Object') {
         my $overload = overload::Method($a, '~~');
         return $a->$overload($b, 0) if $overload;
     }
 
     # XXX perlsyn currently has this undef case after the Num cases, but that's
     # not how it's currently implemented
-    if (type($a) eq 'undef') {
+    if ($type_a eq 'undef') {
         return !defined($b);
     }
-    elsif (type($b) eq 'Num') {
+    elsif ($type_b eq 'Num') {
         no warnings 'uninitialized', 'numeric'; # ugh
         return $a == $b;
     }
-    elsif (type($a) eq 'Num' && type($b) eq 'numish') {
+    elsif ($type_a eq 'Num' && $type_b eq 'numish') {
         return $a == $b;
     }
     else {
-- 
cgit v1.2.3-54-g00ecf