summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-07-09 01:09:26 -0500
committerJesse Luehrs <doy@tozt.net>2011-07-09 01:09:26 -0500
commit9ac064cd621e6f950efc7a9f77999df0322e4393 (patch)
tree23fad28377cd90e206ce558829345fd35b9607b4 /lib
parent24f8e2456eb1fbf787d6300cecdbeb5fb7a98044 (diff)
downloadsmartmatch-engine-core-9ac064cd621e6f950efc7a9f77999df0322e4393.tar.gz
smartmatch-engine-core-9ac064cd621e6f950efc7a9f77999df0322e4393.zip
make the pure perl version a bit faster
Diffstat (limited to 'lib')
-rw-r--r--lib/smartmatch/engine/core.pm47
1 files changed, 25 insertions, 22 deletions
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 {