]> git.vpit.fr Git - perl/modules/Sub-Op.git/blobdiff - lib/Sub/Op.pm
Rename Sub::Op::Test to Sub::Op::LexicalSub
[perl/modules/Sub-Op.git] / lib / Sub / Op.pm
index 94cfe955a538c5d59d7b7b72c8a8e7619570bc9a..8e380ca6835b49a9410b0753778e5a418812b292 100644 (file)
@@ -5,6 +5,16 @@ use 5.010;
 use strict;
 use warnings;
 
+=head1 NAME
+
+Sub::Op - Install subroutines as opcodes.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
 our ($VERSION, @ISA);
 
 sub dl_load_flags { 0x01 }
@@ -16,6 +26,98 @@ BEGIN {
  __PACKAGE__->bootstrap($VERSION);
 }
 
+=head1 SYNOPSIS
+
+In your XS file :
+
+    #include "sub_op.h"
+
+    STATIC OP *scalar_util_reftype(pTHX) {
+     dSP;
+     dMARK;
+     SV *sv = POPs;
+     if (SvMAGICAL(sv))
+      mg_get(sv);
+     if (SvROK(sv))
+      PUSHs(sv_reftype(SvRV(sv), 0));
+     else
+      PUSHs(&PL_sv_undef);
+     RETURN;
+    }
+
+    MODULE = Scalar::Util::Ops       PACKAGE = Scalar::Util::Ops
+
+    BOOT:
+    {
+     sub_op_config_t c;
+     c.name  = "reftype";
+     c.len   = sizeof("reftype")-1;
+     c.pp    = scalar_util_reftype;
+     c.check = 0;
+     c.ud    = NULL;
+     sub_op_register(aTHX_ &c);
+    }
+
+In your Perl module file :
+
+    package Scalar::Util::Ops;
+
+    use strict;
+    use warnings;
+
+    our ($VERSION, @ISA);
+
+    use Sub::Op; # Before loading our own shared library
+
+    BEGIN {
+     $VERSION = '0.01';
+     require DynaLoader;
+     push @ISA, 'DynaLoader';
+     __PACKAGE__->bootstrap($VERSION);
+    }
+
+    sub import   { Sub::Op::enable(reftype => scalar caller) }
+
+    sub unimport { Sub::Op::disable(reftype => scalar caller) }
+
+    1;
+
+In your F<Makefile.PL> :
+
+    use ExtUtils::Depends;
+
+    my $ed = ExtUtils::Depends->new('Scalar::Util::Ops' => 'Sub::Op');
+
+    WriteMakefile(
+     $ed->get_makefile_vars,
+     ...
+    );
+
+=head1 DESCRIPTION
+
+This module provides a C and Perl API for replacing subroutine calls by custom opcodes.
+This has two main advantages :
+
+=over 4
+
+=item *
+
+it gets rid of the overhead of a normal subroutine call ;
+
+=item *
+
+there's no symbol table entry defined for the subroutine.
+
+=back
+
+Subroutine calls with and without parenthesis are handled.
+Ampersand calls are B<not> replaced, and as such will still allow to call a subroutine with same name defined earlier.
+This may or may not be considered as a bug, but it gives the same semantics as Perl keywords, so I believe it's reasonable.
+
+When L<B> and L<B::Deparse> are loaded, they get automatically monkeypatched so that introspecting modules like L<B::Concise> and L<B::Deparse> still produce a valid output.
+
+=cut
+
 use B::Hooks::EndOfScope;
 use Variable::Magic 0.08;
 
@@ -38,8 +140,6 @@ my $sw = Variable::Magic::wizard(
   my $pkg = $data->{pkg};
   my $fqn = join '::', $pkg, $name;
 
-  _incoming($name, $pkg);
-
   no strict 'refs';
   *$fqn = $placeholder unless exists &$fqn;
 
@@ -72,6 +172,72 @@ sub _dispell {
  Variable::Magic::dispell(%{"${pkg}::"}, $sw);
 }
 
+=head1 C API
+
+=head2 C<sub_op_config_t>
+
+A typedef'd struct that configures how L<Sub::Op> should handle a given subroutine name.
+It has the following members :
+
+=over 4
+
+=item *
+
+C<const char *name>
+
+The name of the subroutine you want to replace.
+Allowed to be static.
+
+=item *
+
+C<STRLEN len>
+
+C<name>'s length, in bytes.
+
+=item *
+
+C<Perl_ppaddr_t pp>
+
+The pp function that will be called instead of the subroutine.
+C<Perl_ppaddr_t> is a typedef'd function pointer defined by perl as :
+
+    typedef OP *(*Perl_ppaddr_t)(pTHX);
+
+=item *
+
+C<sub_op_check_t check>
+
+An optional callback that will be called each time a call to C<name> is replaced.
+You can use it to attach extra info to those ops (e.g. with a pointer table) or to perform more optimizations to the optree.
+C<sub_op_check_t> is a typedef'd function pointer defined by :
+
+    typedef OP *(*sub_op_check_t)(pTHX_ OP *, void *);
+
+=item *
+
+C<void *ud>
+
+An optional user data passed to the C<check> callback.
+
+=back
+
+=head2 C<void sub_op_register(pTHX_ const sub_op_config_t *c)>
+
+Registers a name and its configuration into L<Sub::Op>.
+The caller is responsible for allocating and freeing the C<sub_op_config_t> object.
+No pointer to it or to its members is kept.
+
+=head1 PERL API
+
+=head2 C<enable $name, [ $pkg ]>
+
+Enable the replacement with a custom opcode of calls to the C<$name> subroutine of the C<$pkg> package in the current lexical scope.
+A pp callback must have been registered for C<$name> by calling the C function C<sub_op_register> in the XS section of your module.
+
+When C<$pkg> is not set, it defaults to the caller package.
+
+=cut
+
 sub enable {
  my $name = shift;
 
@@ -94,6 +260,14 @@ sub enable {
  return;
 }
 
+=head2 C<disable $name, [ $pkg ]>
+
+Disable the replacement for calls to C<$name> in the package C<$pkg>.
+
+When C<$pkg> is not set, it defaults to the caller package.
+
+=cut
+
 sub disable {
  my $name = shift;
 
@@ -198,4 +372,50 @@ sub _inject {
 
 BEGIN { _monkeypatch() }
 
+=head1 EXAMPLES
+
+See the F<t/Sub-Op-LexicalSub> directory that implements a complete example.
+
+=head1 DEPENDENCIES
+
+L<perl> 5.10.
+
+L<Variable::Magic>, L<B::Hooks::EndOfScope>.
+
+L<ExtUtils::Depends>.
+
+=head1 SEE ALSO
+
+L<subs::auto>.
+
+L<B::Hooks::OP::Check::EntersubForCV>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-sub-op at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sub-Op>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc Sub::Op
+
+Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Sub-Op>.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
 1; # End of Sub::Op