#!/usr/bin/perl

package B::XSUB::Dumber;

use strict;
use warnings;

use Carp qw(croak);
use B qw(svref_2object class);
use B::Generate;
use Scalar::Util qw(reftype);
use XSLoader;

our $VERSION = '0.01';

XSLoader::load __PACKAGE__, $VERSION;

use base qw(B::OPCheck);

sub null {
    my $op = shift;
    return class($op) eq "NULL";
}

sub import {
	my ( $class, @subs ) = @_;

	my $xsubs = $^H{$class} || do {
		my %xsubs;
		use B::Utils;
		$class->SUPER::import(entersub => check => sub {
			my $op = shift;

			# FIXME only if !hasargs

			return unless null $op->first->sibling; # method

			my $kid = $op->first;
			$kid = $kid->first->sibling; # skip ex-list, pushmark
			while ( not null $kid->sibling ) {
				$kid = $kid->sibling;
			}

			my $cvop = $kid->first;

			if ($cvop->name eq "gv") {
				my $gv = $cvop->gv;
				my $cv = $gv->CV;
				if ( my $xsub = $cv->XSUB ) {
					if ( $xsubs{$xsub} ) {
						$op->ppaddr(simple_xsub_ppaddr());
						#$op->ppaddr($xsub); # not possible, it's not a PP (returns an OP*)
					}
				}
			}
		});

		\%xsubs;
	};

	foreach my $sub ( @subs ) {
		my $ref;

		unless ( ref($sub) ) {
			$ref = eval 'package ' . caller(). '; no strict "refs"; \&{$sub}';
			warn $@ if $@;
		} elsif ( reftype($sub) eq 'CODE' ) {
			$ref = $sub;
		}

		unless ( ref($ref) && reftype($ref) eq 'CODE' ) {
			croak "Must supply a sub name or a code reference to an XSUB";
		}

		my $xsub = svref_2object($ref)->XSUB;

		unless ( $xsub ) {
			croak "$sub is not an XSUB";
		}

		$xsubs->{$xsub}++;
	}
}

sub unimport {
	my $class = shift;
	$class->SUPER::unimport(); # FIXME only call if really everything is removed, and with the right opname and callback sub
}

__PACKAGE__

__END__

=pod

=head1 NAME

B::XSUB::Dumber - L<B::OPCheck> demo for microoptimizing XSUB invocation.

=head1 SYNOPSIS

	use Scalar::Util qw(blessed reftype);

	{
		use B::XSUB::Dumber qw(blessed reftype);
		reftype($thingy);
	}

=head1 DESCRIPTION

Certain XSUBs don't need lots of fluff from pp_entersub to be invoked since
they don't do anything fancy. For XSUBs fitting this description this module
lexically replaces the implementation of the entersub ops calling them with a
much simpler version that doesn't do anything except invoke the XSUB function
pointer from the CV.

This is meant mostly as a demo of the sort of thing B::OPCheck lets you do, so
please don't take it too seriously or rely on it in any way.

=head1 VERSION CONTROL

This module is maintained using Darcs. You can get the latest version from
L<http://nothingmuch.woobling.org/code>, and use C<darcs send> to commit
changes.

=head1 AUTHOR

Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>

=head1 COPYRIGHT

	Copyright (c) 2008 Yuval Kogman. All rights reserved
	This program is free software; you can redistribute
	it and/or modify it under the same terms as Perl itself.

=cut