split this out into its own dist, and implement the custom opcode

15 files changed, 618 insertions, 473 deletions

diff --git a/.gitignore b/.gitignore
index bb4f04d..281733a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,4 +9,4 @@ nytprof.out
 MANIFEST.bak
 *.sw[po]
 .build
-smartmatch-*
+smartmatch-engine-core-*
diff --git a/Changes b/Changes
index eb268bc..8c88aba 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,4 @@
-Revision history for smartmatch
+Revision history for smartmatch::engine::core
 
 {{$NEXT}}
       - Initial release
diff --git a/core.xs b/core.xs
new file mode 100644
index 0000000..3f12ea2
--- /dev/null
+++ b/core.xs
@@ -0,0 +1,44 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+#include "stolen_chunk_of_pp_ctl.c"
+
+STATIC OP*
+install_sm_op(pTHX_ OP *o, GV *gv, SV *ud)
+{
+    OP *list, *left, *right, *new;
+
+    list = cUNOPo->op_first;
+    left = cLISTOPx(list)->op_first->op_sibling; /* skip over the pushmark */
+    right = left->op_sibling;
+
+    cLISTOPx(list)->op_first->op_sibling = right->op_sibling;
+    left->op_sibling = right->op_sibling = NULL;
+    op_free(o);
+
+    new = newBINOP(OP_CUSTOM, 0, left, right);
+    new->op_ppaddr = INT2PTR(Perl_ppaddr_t, Perl_pp_old_smartmatch);
+
+    return new;
+}
+
+MODULE = smartmatch::engine::core  PACKAGE = smartmatch::engine::core
+
+PROTOTYPES: DISABLE
+
+void
+init(match)
+    SV *match;
+    PREINIT:
+    CV *cv;
+    CODE:
+        if (!SvROK(match) || SvTYPE(SvRV(match)) != SVt_PVCV) {
+            croak("not a coderef");
+        }
+
+        cv = (CV*)SvRV(match);
+
+        cv_set_call_checker(cv, install_sm_op, (SV*)cv);
diff --git a/dist.ini b/dist.ini
index 8eecae1..b4b10ee 100644
--- a/dist.ini
+++ b/dist.ini
@@ -1,21 +1,10 @@
-name = smartmatch
+name = smartmatch-engine-core
 author = Jesse Luehrs <doy at tozt dot net>
 license = Perl_5
 copyright_holder = Jesse Luehrs
 
-; authordep Dist::Zilla::PluginBundle::DOY
-[@Filter]
--bundle = @DOY
--remove = MakeMaker
-dist = smartmatch
-
-; authordep Dist::Zilla::Plugin::MakeMaker::Awesome
-[=inc::MakeMaker]
+[@DOY]
+dist = smartmatch-engine-core
 
 [Prereqs]
-B::Hooks::OP::Check = 0.14
-perl = 5.010
-
-[Prereqs / ConfigureRequires]
-B::Hooks::OP::Check = 0.14
-ExtUtils::Depends = 0
+smartmatch = 0
diff --git a/hook_op_check_smartmatch.h b/hook_op_check_smartmatch.h
deleted file mode 100644
index b6ddf19..0000000
--- a/hook_op_check_smartmatch.h
+++ /dev/null
@@ -1,9 +0,0 @@
-#ifndef __HOOK_OP_CHECK_SMARTMATCH_H__
-#define __HOOK_OP_CHECK_SMARTMATCH_H__
-
-#include "perl.h"
-#include "hook_op_check.h"
-
-UV hook_op_check_smartmatch();
-
-#endif
diff --git a/inc/MakeMaker.pm b/inc/MakeMaker.pm
deleted file mode 100644
index a1b5ed6..0000000
--- a/inc/MakeMaker.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package inc::MakeMaker;
-use Moose;
-
-extends 'Dist::Zilla::Plugin::MakeMaker::Awesome';
-
-override _build_MakeFile_PL_template => sub {
-    my $self = shift;
-
-    my $tmpl = super;
-
-    my $depends = <<'END';
-%WriteMakefileArgs = (
-    %WriteMakefileArgs,
-    ExtUtils::Depends->new('smartmatch', 'B::Hooks::OP::Check')->get_makefile_vars,
-);
-END
-
-    $tmpl =~ s/(use ExtUtils.*)/$1\nuse ExtUtils::Depends;/;
-    $tmpl =~ s/(WriteMakefile\()/$depends\n$1/;
-
-    return $tmpl;
-};
-
-__PACKAGE__->meta->make_immutable;
-1;
diff --git a/lib/smartmatch.pm b/lib/smartmatch.pm
deleted file mode 100644
index 071e4ea..0000000
--- a/lib/smartmatch.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-package smartmatch;
-use strict;
-use warnings;
-use 5.010;
-# ABSTRACT: pluggable smart matching backends
-
-use parent 'DynaLoader';
-use B::Hooks::OP::Check;
-
-sub dl_load_flags { 0x01 }
-
-__PACKAGE__->bootstrap(
-    # we need to be careful not to touch $VERSION at compile time, otherwise
-    # DynaLoader will assume it's set and check against it, which will cause
-    # fail when being run in the checkout without dzil having set the actual
-    # $VERSION
-    exists $smartmatch::{VERSION}
-        ? ${ $smartmatch::{VERSION} } : (),
-);
-
-sub import {
-    my $package = shift;
-    my ($cb) = @_;
-
-    if (!ref($cb)) {
-        my $engine = "smartmatch::engine::$cb";
-        eval "require $engine; 1"
-            or die "Couldn't load smartmatch engine $engine: $@";
-        $cb = $engine->can('match') unless ref($cb);
-    }
-
-    smartmatch::register($cb);
-}
-
-sub unimport {
-    smartmatch::unregister();
-}
-
-1;
diff --git a/lib/smartmatch/engine/core.pm b/lib/smartmatch/engine/core.pm
index 410c983..948152f 100644
--- a/lib/smartmatch/engine/core.pm
+++ b/lib/smartmatch/engine/core.pm
@@ -2,6 +2,21 @@ package smartmatch::engine::core;
 use strict;
 use warnings;
 use 5.010;
+# ABSTRACT: default smartmatch implementation from 5.10 - 5.14
+
+use parent 'DynaLoader';
+
+sub dl_load_flags { 0x01 }
+
+__PACKAGE__->bootstrap(
+    # we need to be careful not to touch $VERSION at compile time, otherwise
+    # DynaLoader will assume it's set and check against it, which will cause
+    # fail when being run in the checkout without dzil having set the actual
+    # $VERSION
+    exists $smartmatch::engine::core::{VERSION}
+        ? ${ $smartmatch::engine::core::{VERSION} } : (),
+);
+smartmatch::engine::core::init(__PACKAGE__->can('match'));
 
 use B;
 use Carp qw(croak);
diff --git a/lib/smartmatch/engine/rjbs.pm b/lib/smartmatch/engine/rjbs.pm
deleted file mode 100644
index da40998..0000000
--- a/lib/smartmatch/engine/rjbs.pm
+++ /dev/null
@@ -1,62 +0,0 @@
-package smartmatch::engine::rjbs;
-use strict;
-use warnings;
-
-use overload ();
-use Scalar::Util qw(blessed reftype);
-
-sub type {
-    my ($thing) = @_;
-
-    if (!defined($thing)) {
-        return 'undef';
-    }
-    elsif (!ref($thing)) {
-        return 'unknown non-ref';
-    }
-    elsif (reftype($thing) eq 'REGEXP') {
-        return 'Regex';
-    }
-    elsif (blessed($thing)) {
-        if (overload::Method($thing, '~~')) {
-            return 'Overloaded';
-        }
-        elsif (overload::Method($thing, 'qr')) {
-            return 'Regex';
-        }
-        else {
-            return 'unknown object';
-        }
-    }
-    elsif (reftype($thing) eq 'CODE') {
-        return 'Code';
-    }
-    else {
-        return 'unknown';
-    }
-}
-
-sub match {
-    my ($a, $b) = @_;
-
-    if (type($b) eq 'undef') {
-        return !defined($a);
-    }
-    elsif (type($b) eq 'Overloaded') {
-        my $overload = overload::Method($b, '~~');
-        return $b->$overload($a, 1);
-    }
-    elsif (type($b) eq 'Regex') {
-        return $a =~ $b;
-    }
-    elsif (type($b) eq 'Code') {
-        return $b->($a);
-    }
-    else {
-        $a //= 'undef';
-        $b //= 'undef';
-        die "invalid smart match: $a ~~ $b";
-    }
-}
-
-1;
diff --git a/smartmatch.xs b/smartmatch.xs
deleted file mode 100644
index 36d7c51..0000000
--- a/smartmatch.xs
+++ /dev/null
@@ -1,70 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#include "ppport.h"
-
-#include "hook_op_check_smartmatch.h"
-
-STATIC OP*
-smartmatch_cb(pTHX_ OP *o, void *user_data)
-{
-    OP *left, *right, *cb_op, *list, *new;
-    SV **cb;
-
-    cb = hv_fetchs(GvHV(PL_hintgv), "smartmatch_cb", 0);
-    if (!cb) {
-        return o;
-    }
-
-    left = cBINOPo->op_first;
-    right = left->op_sibling;
-
-    o->op_flags &= ~OPf_KIDS;
-    op_free(o);
-
-    cb_op = newCVREF(0, newSVOP(OP_CONST, 0, newSVsv(*cb)));
-    list = newLISTOP(OP_LIST, 0, left, right);
-    new = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                  op_append_elem(OP_LIST, list, cb_op));
-
-    return new;
-}
-
-UV
-hook_op_check_smartmatch()
-{
-    return hook_op_check(OP_SMARTMATCH, smartmatch_cb, NULL);
-}
-
-MODULE = smartmatch  PACKAGE = smartmatch
-
-PROTOTYPES: DISABLE
-
-BOOT:
-    hook_op_check_smartmatch();
-
-void
-register (cb)
-    SV *cb;
-    CODE:
-        if (!SvROK(cb) || SvTYPE(SvRV(cb)) != SVt_PVCV) {
-            croak("not a coderef");
-        }
-
-        PL_hints |= HINT_LOCALIZE_HH;
-        gv_HVadd(PL_hintgv);
-
-        SvREFCNT_inc(cb);
-        if (!hv_stores(GvHV(PL_hintgv), "smartmatch_cb", cb)) {
-            SvREFCNT_dec(cb);
-            croak("couldn't store the callback");
-        }
-
-void
-unregister ()
-    CODE:
-        PL_hints |= HINT_LOCALIZE_HH;
-        gv_HVadd(PL_hintgv);
-
-        hv_delete(GvHV(PL_hintgv), "smartmatch_cb", 13, G_DISCARD);
diff --git a/stolen_chunk_of_pp_ctl.c b/stolen_chunk_of_pp_ctl.c
new file mode 100644
index 0000000..c9becd7
--- /dev/null
+++ b/stolen_chunk_of_pp_ctl.c
@@ -0,0 +1,553 @@
+/* embed.h */
+
+#define destroy_matcher(a)	S_destroy_matcher(aTHX_ a)
+#define do_smartmatch(a,b)	S_do_smartmatch(aTHX_ a,b)
+#define make_matcher(a)		S_make_matcher(aTHX_ a)
+#define matcher_matches_sv(a,b)	S_matcher_matches_sv(aTHX_ a,b)
+
+/* proto.h */
+
+STATIC void	S_destroy_matcher(pTHX_ PMOP* matcher)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_DESTROY_MATCHER	\
+	assert(matcher)
+
+STATIC OP*	S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other);
+
+STATIC PMOP*	S_make_matcher(pTHX_ REGEXP* re)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_MAKE_MATCHER	\
+	assert(re)
+
+STATIC bool	S_matcher_matches_sv(pTHX_ PMOP* matcher, SV* sv)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_MATCHER_MATCHES_SV	\
+	assert(matcher); assert(sv)
+
+/* pp_ctl.c */
+
+STATIC PMOP *
+S_make_matcher(pTHX_ REGEXP *re)
+{
+    dVAR;
+    PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
+
+    PERL_ARGS_ASSERT_MAKE_MATCHER;
+
+    PM_SETRE(matcher, ReREFCNT_inc(re));
+
+    SAVEFREEOP((OP *) matcher);
+    ENTER_with_name("matcher"); SAVETMPS;
+    SAVEOP();
+    return matcher;
+}
+
+STATIC bool
+S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
+{
+    dVAR;
+    dSP;
+
+    PERL_ARGS_ASSERT_MATCHER_MATCHES_SV;
+    
+    PL_op = (OP *) matcher;
+    XPUSHs(sv);
+    PUTBACK;
+    (void) Perl_pp_match(aTHX);
+    SPAGAIN;
+    return (SvTRUEx(POPs));
+}
+
+STATIC void
+S_destroy_matcher(pTHX_ PMOP *matcher)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_DESTROY_MATCHER;
+    PERL_UNUSED_ARG(matcher);
+
+    FREETMPS;
+    LEAVE_with_name("matcher");
+}
+
+PP(pp_old_smartmatch)
+{
+    DEBUG_M(Perl_deb(aTHX_ "Starting smart match resolution\n"));
+    return do_smartmatch(NULL, NULL);
+}
+
+STATIC OP *
+S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+{
+    dVAR;
+    dSP;
+    
+    bool object_on_left = FALSE;
+    SV *e = TOPs;	/* e is for 'expression' */
+    SV *d = TOPm1s;	/* d is for 'default', as in PL_defgv */
+
+    /* Take care only to invoke mg_get() once for each argument.
+     * Currently we do this by copying the SV if it's magical. */
+    if (d) {
+	if (SvGMAGICAL(d))
+	    d = sv_mortalcopy(d);
+    }
+    else
+	d = &PL_sv_undef;
+
+    assert(e);
+    if (SvGMAGICAL(e))
+	e = sv_mortalcopy(e);
+
+    /* First of all, handle overload magic of the rightmost argument */
+    if (SvAMAGIC(e)) {
+	SV * tmpsv;
+	DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
+	DEBUG_M(Perl_deb(aTHX_ "        attempting overload\n"));
+
+	tmpsv = amagic_call(d, e, smart_amg, 0);
+	if (tmpsv) {
+	    SPAGAIN;
+	    (void)POPs;
+	    SETs(tmpsv);
+	    RETURN;
+	}
+	DEBUG_M(Perl_deb(aTHX_ "        failed to run overload method; continuing...\n"));
+    }
+
+    SP -= 2;	/* Pop the values */
+
+
+    /* ~~ undef */
+    if (!SvOK(e)) {
+	DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-undef\n"));
+	if (SvOK(d))
+	    RETPUSHNO;
+	else
+	    RETPUSHYES;
+    }
+
+    if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) {
+	DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Object\n"));
+	Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+    }
+    if (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
+	object_on_left = TRUE;
+
+    /* ~~ sub */
+    if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) {
+	I32 c;
+	if (object_on_left) {
+	    goto sm_any_sub; /* Treat objects like scalars */
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+	    /* Test sub truth for each key */
+	    HE *he;
+	    bool andedresults = TRUE;
+	    HV *hv = (HV*) SvRV(d);
+	    I32 numkeys = hv_iterinit(hv);
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Hash-CodeRef\n"));
+	    if (numkeys == 0)
+		RETPUSHYES;
+	    while ( (he = hv_iternext(hv)) ) {
+		DEBUG_M(Perl_deb(aTHX_ "        testing hash key...\n"));
+		ENTER_with_name("smartmatch_hash_key_test");
+		SAVETMPS;
+		PUSHMARK(SP);
+		PUSHs(hv_iterkeysv(he));
+		PUTBACK;
+		c = call_sv(e, G_SCALAR);
+		SPAGAIN;
+		if (c == 0)
+		    andedresults = FALSE;
+		else
+		    andedresults = SvTRUEx(POPs) && andedresults;
+		FREETMPS;
+		LEAVE_with_name("smartmatch_hash_key_test");
+	    }
+	    if (andedresults)
+		RETPUSHYES;
+	    else
+		RETPUSHNO;
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+	    /* Test sub truth for each element */
+	    I32 i;
+	    bool andedresults = TRUE;
+	    AV *av = (AV*) SvRV(d);
+	    const I32 len = av_len(av);
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Array-CodeRef\n"));
+	    if (len == -1)
+		RETPUSHYES;
+	    for (i = 0; i <= len; ++i) {
+		SV * const * const svp = av_fetch(av, i, FALSE);
+		DEBUG_M(Perl_deb(aTHX_ "        testing array element...\n"));
+		ENTER_with_name("smartmatch_array_elem_test");
+		SAVETMPS;
+		PUSHMARK(SP);
+		if (svp)
+		    PUSHs(*svp);
+		PUTBACK;
+		c = call_sv(e, G_SCALAR);
+		SPAGAIN;
+		if (c == 0)
+		    andedresults = FALSE;
+		else
+		    andedresults = SvTRUEx(POPs) && andedresults;
+		FREETMPS;
+		LEAVE_with_name("smartmatch_array_elem_test");
+	    }
+	    if (andedresults)
+		RETPUSHYES;
+	    else
+		RETPUSHNO;
+	}
+	else {
+	  sm_any_sub:
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-CodeRef\n"));
+	    ENTER_with_name("smartmatch_coderef");
+	    SAVETMPS;
+	    PUSHMARK(SP);
+	    PUSHs(d);
+	    PUTBACK;
+	    c = call_sv(e, G_SCALAR);
+	    SPAGAIN;
+	    if (c == 0)
+		PUSHs(&PL_sv_no);
+	    else if (SvTEMP(TOPs))
+		SvREFCNT_inc_void(TOPs);
+	    FREETMPS;
+	    LEAVE_with_name("smartmatch_coderef");
+	    RETURN;
+	}
+    }
+    /* ~~ %hash */
+    else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVHV) {
+	if (object_on_left) {
+	    goto sm_any_hash; /* Treat objects like scalars */
+	}
+	else if (!SvOK(d)) {
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Hash ($a undef)\n"));
+	    RETPUSHNO;
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+	    /* Check that the key-sets are identical */
+	    HE *he;
+	    HV *other_hv = MUTABLE_HV(SvRV(d));
+	    bool tied = FALSE;
+	    bool other_tied = FALSE;
+	    U32 this_key_count  = 0,
+	        other_key_count = 0;
+	    HV *hv = MUTABLE_HV(SvRV(e));
+
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Hash-Hash\n"));
+	    /* Tied hashes don't know how many keys they have. */
+	    if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
+		tied = TRUE;
+	    }
+	    else if (SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied)) {
+		HV * const temp = other_hv;
+		other_hv = hv;
+		hv = temp;
+		tied = TRUE;
+	    }
+	    if (SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied))
+		other_tied = TRUE;
+	    
+	    if (!tied && HvUSEDKEYS((const HV *) hv) != HvUSEDKEYS(other_hv))
+	    	RETPUSHNO;
+
+	    /* The hashes have the same number of keys, so it suffices
+	       to check that one is a subset of the other. */
+	    (void) hv_iterinit(hv);
+	    while ( (he = hv_iternext(hv)) ) {
+		SV *key = hv_iterkeysv(he);
+
+		DEBUG_M(Perl_deb(aTHX_ "        comparing hash key...\n"));
+	    	++ this_key_count;
+	    	
+	    	if(!hv_exists_ent(other_hv, key, 0)) {
+	    	    (void) hv_iterinit(hv);	/* reset iterator */
+		    RETPUSHNO;
+	    	}
+	    }
+	    
+	    if (other_tied) {
+		(void) hv_iterinit(other_hv);
+		while ( hv_iternext(other_hv) )
+		    ++other_key_count;
+	    }
+	    else
+		other_key_count = HvUSEDKEYS(other_hv);
+	    
+	    if (this_key_count != other_key_count)
+		RETPUSHNO;
+	    else
+		RETPUSHYES;
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+	    AV * const other_av = MUTABLE_AV(SvRV(d));
+	    const I32 other_len = av_len(other_av) + 1;
+	    I32 i;
+	    HV *hv = MUTABLE_HV(SvRV(e));
+
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Array-Hash\n"));
+	    for (i = 0; i < other_len; ++i) {
+		SV ** const svp = av_fetch(other_av, i, FALSE);
+		DEBUG_M(Perl_deb(aTHX_ "        checking for key existence...\n"));
+		if (svp) {	/* ??? When can this not happen? */
+		    if (hv_exists_ent(hv, *svp, 0))
+		        RETPUSHYES;
+		}
+	    }
+	    RETPUSHNO;
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) {
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Regex-Hash\n"));
+	  sm_regex_hash:
+	    {
+		PMOP * const matcher = make_matcher((REGEXP*) SvRV(d));
+		HE *he;
+		HV *hv = MUTABLE_HV(SvRV(e));
+
+		(void) hv_iterinit(hv);
+		while ( (he = hv_iternext(hv)) ) {
+		    DEBUG_M(Perl_deb(aTHX_ "        testing key against pattern...\n"));
+		    if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
+			(void) hv_iterinit(hv);
+			destroy_matcher(matcher);
+			RETPUSHYES;
+		    }
+		}
+		destroy_matcher(matcher);
+		RETPUSHNO;
+	    }
+	}
+	else {
+	  sm_any_hash:
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Hash\n"));
+	    if (hv_exists_ent(MUTABLE_HV(SvRV(e)), d, 0))
+		RETPUSHYES;
+	    else
+		RETPUSHNO;
+	}
+    }
+    /* ~~ @array */
+    else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVAV) {
+	if (object_on_left) {
+	    goto sm_any_array; /* Treat objects like scalars */
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+	    AV * const other_av = MUTABLE_AV(SvRV(e));
+	    const I32 other_len = av_len(other_av) + 1;
+	    I32 i;
+
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Hash-Array\n"));
+	    for (i = 0; i < other_len; ++i) {
+		SV ** const svp = av_fetch(other_av, i, FALSE);
+
+		DEBUG_M(Perl_deb(aTHX_ "        testing for key existence...\n"));
+		if (svp) {	/* ??? When can this not happen? */
+		    if (hv_exists_ent(MUTABLE_HV(SvRV(d)), *svp, 0))
+		        RETPUSHYES;
+		}
+	    }
+	    RETPUSHNO;
+	}
+	if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+	    AV *other_av = MUTABLE_AV(SvRV(d));
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Array-Array\n"));
+	    if (av_len(MUTABLE_AV(SvRV(e))) != av_len(other_av))
+		RETPUSHNO;
+	    else {
+	    	I32 i;
+	    	const I32 other_len = av_len(other_av);
+
+		if (NULL == seen_this) {
+		    seen_this = newHV();
+		    (void) sv_2mortal(MUTABLE_SV(seen_this));
+		}
+		if (NULL == seen_other) {
+		    seen_other = newHV();
+		    (void) sv_2mortal(MUTABLE_SV(seen_other));
+		}
+		for(i = 0; i <= other_len; ++i) {
+		    SV * const * const this_elem = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
+		    SV * const * const other_elem = av_fetch(other_av, i, FALSE);
+
+		    if (!this_elem || !other_elem) {
+			if ((this_elem && SvOK(*this_elem))
+				|| (other_elem && SvOK(*other_elem)))
+			    RETPUSHNO;
+		    }
+		    else if (hv_exists_ent(seen_this,
+				sv_2mortal(newSViv(PTR2IV(*this_elem))), 0) ||
+			    hv_exists_ent(seen_other,
+				sv_2mortal(newSViv(PTR2IV(*other_elem))), 0))
+		    {
+			if (*this_elem != *other_elem)
+			    RETPUSHNO;
+		    }
+		    else {
+			(void)hv_store_ent(seen_this,
+				sv_2mortal(newSViv(PTR2IV(*this_elem))),
+				&PL_sv_undef, 0);
+			(void)hv_store_ent(seen_other,
+				sv_2mortal(newSViv(PTR2IV(*other_elem))),
+				&PL_sv_undef, 0);
+			PUSHs(*other_elem);
+			PUSHs(*this_elem);
+			
+			PUTBACK;
+			DEBUG_M(Perl_deb(aTHX_ "        recursively comparing array element...\n"));
+			(void) do_smartmatch(seen_this, seen_other);
+			SPAGAIN;
+			DEBUG_M(Perl_deb(aTHX_ "        recursion finished\n"));
+			
+			if (!SvTRUEx(POPs))
+			    RETPUSHNO;
+		    }
+		}
+		RETPUSHYES;
+	    }
+	}
+	else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) {
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Regex-Array\n"));
+	  sm_regex_array:
+	    {
+		PMOP * const matcher = make_matcher((REGEXP*) SvRV(d));
+		const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
+		I32 i;
+
+		for(i = 0; i <= this_len; ++i) {
+		    SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
+		    DEBUG_M(Perl_deb(aTHX_ "        testing element against pattern...\n"));
+		    if (svp && matcher_matches_sv(matcher, *svp)) {
+			destroy_matcher(matcher);
+			RETPUSHYES;
+		    }
+		}
+		destroy_matcher(matcher);
+		RETPUSHNO;
+	    }
+	}
+	else if (!SvOK(d)) {
+	    /* undef ~~ array */
+	    const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
+	    I32 i;
+
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Undef-Array\n"));
+	    for (i = 0; i <= this_len; ++i) {
+		SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
+		DEBUG_M(Perl_deb(aTHX_ "        testing for undef element...\n"));
+		if (!svp || !SvOK(*svp))
+		    RETPUSHYES;
+	    }
+	    RETPUSHNO;
+	}
+	else {
+	  sm_any_array:
+	    {
+		I32 i;
+		const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
+
+		DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Array\n"));
+		for (i = 0; i <= this_len; ++i) {
+		    SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
+		    if (!svp)
+			continue;
+
+		    PUSHs(d);
+		    PUSHs(*svp);
+		    PUTBACK;
+		    /* infinite recursion isn't supposed to happen here */
+		    DEBUG_M(Perl_deb(aTHX_ "        recursively testing array element...\n"));
+		    (void) do_smartmatch(NULL, NULL);
+		    SPAGAIN;
+		    DEBUG_M(Perl_deb(aTHX_ "        recursion finished\n"));
+		    if (SvTRUEx(POPs))
+			RETPUSHYES;
+		}
+		RETPUSHNO;
+	    }
+	}
+    }
+    /* ~~ qr// */
+    else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_REGEXP) {
+	if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+	    SV *t = d; d = e; e = t;
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Hash-Regex\n"));
+	    goto sm_regex_hash;
+	}
+	else if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+	    SV *t = d; d = e; e = t;
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Array-Regex\n"));
+	    goto sm_regex_array;
+	}
+	else {
+	    PMOP * const matcher = make_matcher((REGEXP*) SvRV(e));
+
+	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Regex\n"));
+	    PUTBACK;
+	    PUSHs(matcher_matches_sv(matcher, d)
+		    ? &PL_sv_yes
+		    : &PL_sv_no);
+	    destroy_matcher(matcher);
+	    RETURN;
+	}
+    }
+    /* ~~ scalar */
+    /* See if there is overload magic on left */
+    else if (object_on_left && SvAMAGIC(d)) {
+	SV *tmpsv;
+	DEBUG_M(Perl_deb(aTHX_ "    applying rule Object-Any\n"));
+	DEBUG_M(Perl_deb(aTHX_ "        attempting overload\n"));
+	PUSHs(d); PUSHs(e);
+	PUTBACK;
+	tmpsv = amagic_call(d, e, smart_amg, AMGf_noright);
+	if (tmpsv) {
+	    SPAGAIN;
+	    (void)POPs;
+	    SETs(tmpsv);
+	    RETURN;
+	}
+	SP -= 2;
+	DEBUG_M(Perl_deb(aTHX_ "        failed to run overload method; falling back...\n"));
+	goto sm_any_scalar;
+    }
+    else if (!SvOK(d)) {
+	/* undef ~~ scalar ; we already know that the scalar is SvOK */
+	DEBUG_M(Perl_deb(aTHX_ "    applying rule undef-Any\n"));
+	RETPUSHNO;
+    }
+    else
+  sm_any_scalar:
+    if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) {
+	DEBUG_M(if (SvNIOK(e))
+		    Perl_deb(aTHX_ "    applying rule Any-Num\n");
+		else
+		    Perl_deb(aTHX_ "    applying rule Num-numish\n");
+	);
+	/* numeric comparison */
+	PUSHs(d); PUSHs(e);
+	PUTBACK;
+	if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
+	    (void) Perl_pp_i_eq(aTHX);
+	else
+	    (void) Perl_pp_eq(aTHX);
+	SPAGAIN;
+	if (SvTRUEx(POPs))
+	    RETPUSHYES;
+	else
+	    RETPUSHNO;
+    }
+    
+    /* As a last resort, use string comparison */
+    DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-Any\n"));
+    PUSHs(d); PUSHs(e);
+    PUTBACK;
+    return Perl_pp_seq(aTHX);
+}
diff --git a/t/basic.t b/t/basic.t
deleted file mode 100644
index 1de7d8f..0000000
--- a/t/basic.t
+++ /dev/null
@@ -1,20 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More;
-
-ok(1 ~~ 1);
-{
-    use smartmatch sub { 0 };
-    ok(!(1 ~~ 1));
-    ok(!(1 ~~ 2));
-}
-ok(1 ~~ 1);
-
-{
-    use smartmatch 'core';
-    ok(1 ~~ 1);
-    ok(!(1 ~~ 2));
-}
-
-done_testing;
diff --git a/t/lexical.t b/t/lexical.t
deleted file mode 100644
index 036fe8a..0000000
--- a/t/lexical.t
+++ /dev/null
@@ -1,69 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More;
-
-{
-    ok(1 ~~ 1);
-    ok(!(1 ~~ 0));
-    {
-        ok(1 ~~ 1);
-        ok(!(1 ~~ 0));
-        use smartmatch sub { 0 };
-        ok(!(1 ~~ 1));
-        ok(!(1 ~~ 0));
-        {
-            ok(!(1 ~~ 1));
-            ok(!(1 ~~ 0));
-            use smartmatch sub { 1 };
-            ok(1 ~~ 1);
-            ok(1 ~~ 0);
-            use smartmatch sub { 0 };
-            ok(!(1 ~~ 1));
-            ok(!(1 ~~ 0));
-            use smartmatch sub { 1 };
-            ok(1 ~~ 1);
-            ok(1 ~~ 0);
-        }
-        ok(!(1 ~~ 1));
-        ok(!(1 ~~ 0));
-    }
-    ok(1 ~~ 1);
-    ok(!(1 ~~ 0));
-}
-
-{
-    ok(eval "1 ~~ 1");
-    ok(!eval "1 ~~ 0");
-    {
-        ok(eval "1 ~~ 1");
-        ok(!eval "1 ~~ 0");
-        use smartmatch sub { 0 };
-        ok(!eval "1 ~~ 1");
-        ok(!eval "1 ~~ 0");
-        {
-            ok(!eval "1 ~~ 1");
-            ok(!eval "1 ~~ 0");
-            use smartmatch sub { 1 };
-            ok(eval "1 ~~ 1");
-            ok(eval "1 ~~ 0");
-            use smartmatch sub { 0 };
-            ok(!eval "1 ~~ 1");
-            ok(!eval "1 ~~ 0");
-            use smartmatch sub { 1 };
-            ok(eval "1 ~~ 1");
-            ok(eval "1 ~~ 0");
-        }
-        ok(!eval "1 ~~ 1");
-        ok(!eval "1 ~~ 0");
-    }
-    ok(eval "1 ~~ 1");
-    ok(!eval "1 ~~ 0");
-}
-
-{
-    use smartmatch sub { 0 };
-    require 't/lib/lexical.pl';
-}
-
-done_testing;
diff --git a/t/lib/lexical.pl b/t/lib/lexical.pl
deleted file mode 100644
index d004c3f..0000000
--- a/t/lib/lexical.pl
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-
-Test::More::ok(1 ~~ 1);
-Test::More::ok(!(1 ~~ 0));
-
-1;
diff --git a/t/rjbs.t b/t/rjbs.t
deleted file mode 100644
index b94e893..0000000
--- a/t/rjbs.t
+++ /dev/null
@@ -1,154 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More;
-
-use smartmatch 'rjbs';
-
-{
-    package SmartOverload;
-    use overload '~~' => sub {
-        no warnings 'uninitialized';
-        return $_[1] eq ${ $_[0] };
-    }, fallback => 1;
-}
-
-{
-    package RegexOverload;
-    use overload 'qr' => sub {
-        return $_[0]->[0];
-    }, fallback => 1;
-}
-
-{
-    package StringOverload;
-    use overload '""' => sub {
-        return $_[0]->{val};
-    }, fallback => 1;
-}
-
-sub smart  { my $val = shift; bless \$val,           SmartOverload::  }
-sub regex  { my $val = shift; bless [qr/$val/],      RegexOverload::  }
-sub string { my $val = shift; bless { val => $val }, StringOverload:: }
-
-my @tests = (
-    # undef
-    [ 1,     undef,        undef ],
-    [ 0,     '',           undef ],
-    [ 0,     0,            undef ],
-    [ 0,     '0',          undef ],
-    [ 0,     '0.0',        undef ],
-    [ 0,     '0 but true', undef ],
-    [ 0,     1,            undef ],
-    [ 0,     'x',          undef ],
-    [ 0,     [],           undef ],
-    [ 0,     {},           undef ],
-    [ 0,     sub {},       undef ],
-    [ 0,     smart(''),    undef ],
-    [ 0,     regex(''),    undef ],
-    [ 0,     string(''),   undef ],
-    # smart match overload
-    [ 1,     "smart",         smart('smart') ],
-    [ 1,     string('smart'), smart('smart') ],
-    [ 0,     "SMART",         smart('smart') ],
-    [ 0,     string('SMART'), smart('smart') ],
-    [ 0,     smart('smart'),  smart('smart') ],
-    [ 0,     undef,           smart('smart') ],
-    [ 0,     1,               smart('smart') ],
-    # regex
-    [ 0,     undef,         qr/a/             ],
-    [ 1,     undef,         qr/a?/            ],
-    [ 1,     "foo",         qr/f/             ],
-    [ 0,     "foo",         qr/g/             ],
-    [ 1,     1,             qr/1/             ],
-    [ 0,     ['z'],         qr/z/             ],
-    [ 1,     ['z'],         qr/^ARRAY/        ],
-    [ 0,     {'y' => 'y'},  qr/y/             ],
-    [ 1,     {'y' => 'y'},  qr/^HASH/         ],
-    [ 1,     string('foo'), qr/^foo$/         ],
-    [ 0,     regex('foo'),  qr/foo/           ],
-    [ 1,     regex('foo'),  qr/^Regex/        ],
-    [ 1,     qr/foo/,       qr/\(\?\^\:foo\)/ ],
-    # regex overload
-    [ 0,     undef,         regex('a')             ],
-    [ 1,     undef,         regex('a?')            ],
-    [ 1,     "foo",         regex('f')             ],
-    [ 0,     "foo",         regex('g')             ],
-    [ 1,     1,             regex('1')             ],
-    [ 0,     ['z'],         regex('z')             ],
-    [ 1,     ['z'],         regex('^ARRAY')        ],
-    [ 0,     {'y' => 'y'},  regex('y')             ],
-    [ 1,     {'y' => 'y'},  regex('^HASH')         ],
-    [ 1,     string('foo'), regex('^foo$')         ],
-    [ 0,     regex('foo'),  regex('foo')           ],
-    [ 1,     regex('foo'),  regex('^Regex')        ],
-    [ 1,     qr/foo/,       regex('\(\?\^\:foo\)') ],
-    # code
-    [ 1,     undef,        sub { 1 }                    ],
-    [ 1,     '',           sub { 1 }                    ],
-    [ 1,     0,            sub { 1 }                    ],
-    [ 1,     '0',          sub { 1 }                    ],
-    [ 1,     '0.0',        sub { 1 }                    ],
-    [ 1,     '0 but true', sub { 1 }                    ],
-    [ 1,     1,            sub { 1 }                    ],
-    [ 1,     'x',          sub { 1 }                    ],
-    [ 1,     [],           sub { 1 }                    ],
-    [ 1,     {},           sub { 1 }                    ],
-    [ 1,     sub {},       sub { 1 }                    ],
-    [ 1,     smart(''),    sub { 1 }                    ],
-    [ 1,     regex(''),    sub { 1 }                    ],
-    [ 1,     string(''),   sub { 1 }                    ],
-    [ 0,     undef,        sub { 0 }                    ],
-    [ 0,     '',           sub { 0 }                    ],
-    [ 0,     0,            sub { 0 }                    ],
-    [ 0,     '0',          sub { 0 }                    ],
-    [ 0,     '0.0',        sub { 0 }                    ],
-    [ 0,     '0 but true', sub { 0 }                    ],
-    [ 0,     1,            sub { 0 }                    ],
-    [ 0,     'x',          sub { 0 }                    ],
-    [ 0,     [],           sub { 0 }                    ],
-    [ 0,     {},           sub { 0 }                    ],
-    [ 0,     sub {},       sub { 0 }                    ],
-    [ 0,     smart(''),    sub { 0 }                    ],
-    [ 0,     regex(''),    sub { 0 }                    ],
-    [ 0,     string(''),   sub { 0 }                    ],
-    [ 1,     ['a', 'b'],   sub { ref $_[0] eq 'ARRAY' } ],
-    [ 1,     ['a', 'b'],   sub { $_[0]->[0] eq 'a' }    ],
-    [ 1,     string('x'),  sub { $_[0] eq 'x' }         ],
-    [ 1,     smart('x'),   sub { 'x' ~~ $_[0] }         ],
-    [ 0,     smart('x'),   sub { 'y' ~~ $_[0] }         ],
-    # any
-    [ 'die', undef, ''           ],
-    [ 'die', undef, 0            ],
-    [ 'die', undef, '0'          ],
-    [ 'die', undef, '0.0'        ],
-    [ 'die', undef, '0 but true' ],
-    [ 'die', undef, 1            ],
-    [ 'die', undef, 'x'          ],
-    [ 'die', undef, []           ],
-    [ 'die', undef, {}           ],
-    [ 0,     undef, sub {}       ],
-    [ 1,     undef, smart('')    ],
-    [ 1,     undef, regex('')    ],
-    [ 'die', undef, string('')   ],
-);
-
-for my $test (@tests) {
-    # shut up warnings about undef =~ regex
-    $SIG{__WARN__} = sub { } unless defined $test->[1];
-
-    if ($test->[0] eq 'die') {
-        ok(!eval { $test->[1] ~~ $test->[2]; 1 });
-        like($@, qr/invalid smart match/);
-    }
-    elsif ($test->[0]) {
-        ok($test->[1] ~~ $test->[2]);
-    }
-    else {
-        ok(!($test->[1] ~~ $test->[2]));
-    }
-
-    delete $SIG{__WARN__};
-}
-
-done_testing;