Permalink
Browse files

reimplementation with parser hook and entersub hook.

  • Loading branch information...
1 parent cf7d981 commit c87a4dd57fb41dd09bc67113297980b89eea19a7 @clkao committed Jan 15, 2011
Showing with 44 additions and 84 deletions.
  1. +15 −61 invoker.xs
  2. +25 −15 lib/invoker.pm
  3. +0 −4 t/00_compile.t
  4. +3 −3 t/01basic.t
  5. +1 −1 t/02context.t
View
76 invoker.xs
@@ -26,80 +26,34 @@ typedef struct userdata_St {
} userdata_t;
static OP *
-invoker_ck_gt(pTHX_ OP *o, void *ud) {
- OP *left = cBINOPo->op_first; /* $- */
- OP *right = left->op_sibling; /* the entersub */
-
- if (left->op_type == OP_RV2SV) {
+invoker_ck_entersub(pTHX_ OP *o, void *ud) {
+ OP *f = ((cUNOPo->op_first->op_sibling)
+ ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first; // pushmark
+ OP *arg = f->op_sibling; // the actual first argument
+
+ if (arg->op_type == OP_RV2SV) {
GV *gv;
- left = cUNOPx(left)->op_first;
- if (left->op_type == OP_GV &&
- (gv = cGVOPx_gv(left)) &&
+ OP *gvop = cUNOPx(arg)->op_first;
+ if (gvop->op_type == OP_GV &&
+ (gv = cGVOPx_gv(gvop)) &&
!strcmp(GvNAME_get(gv), "-")) {
+
const PADOFFSET tmp = pad_findmy("$self", 5, 0);
if (tmp == -1) {
croak("$self not found");
}
else {
OP * const self = newOP(OP_PADSV, 0);
self->op_targ = tmp;
- //warn("right: %p %s. self = %d", right, PL_op_name[right->op_type], tmp);
- if (right->op_type == OP_ENTERSUB) {
- OP *f = ((cUNOPx(right)->op_first->op_sibling)
- ? cUNOPx(right) : ((UNOP*)cUNOPx(right)->op_first))->op_first; // pushmark
- OP *o2 = f->op_sibling; // the actual first argument
-
- // warn("right first: %p %s", f, PL_op_name[f->op_type]);
- // warn("right 2: %p %s", o2, PL_op_name[o2->op_type]);
-
- self->op_sibling = o2;
- f->op_sibling = self;
-
- OP *last_arg = o2->op_type == OP_NULL ? f : o2;
- while(last_arg->op_sibling->op_sibling)
- last_arg = last_arg->op_sibling;
-
- // warn("last_arg: %p %s", last_arg, PL_op_name[last_arg->op_type]);
-
- OP *apply = cUNOPx(last_arg->op_sibling)->op_first;
- // warn("apply: %p %s", apply, PL_op_name[apply->op_type]);
- if (apply->op_type == OP_GV) {
- SV *sv = newSVpv(GvNAME_get(cGVOPx_gv(apply)), 0);
- const char *foo = GvNAME_get(cGVOPx_gv(apply));
- OP *cmop = newSVOP(OP_METHOD_NAMED, 0, sv);
- last_arg->op_sibling = cmop;
- }
- else {
- warn("unknown application: %s", PL_op_name[apply->op_type]);
- return o;
- }
-
- // warn("self next = %p %s", self->op_next, PL_op_name[self->op_next->op_type]);
- right->op_flags &= (~OPf_WANT | ( o->op_flags & OPf_WANT));
-
- return right;
- }
- else if (right->op_type == OP_CONST) {
- SV *name = ((SVOP*)right)->op_sv;
- o = (OP *)newUNOP(OP_ENTERSUB, OPf_STACKED,
- op_append_elem(OP_LIST, self,
- newSVOP(OP_METHOD_NAMED, 0, name)));
- return o;
- }
- else {
- SV *sv = ((SVOP*)right)->op_sv;
- o = (OP *)newUNOP(OP_ENTERSUB, OPf_STACKED,
- op_append_elem(OP_LIST, self,
- newUNOP(OP_METHOD, 0, right)));
- return o;
- }
+ f->op_sibling = self;
+ self->op_sibling = arg->op_sibling;
+ op_free(arg);
}
}
}
return o;
}
-
MODULE = invoker PACKAGE = invoker
PROTOTYPES: ENABLE
@@ -112,7 +66,7 @@ setup (class)
Newx (ud, 1, userdata_t);
CODE:
ud->class = newSVsv (class);
- RETVAL = hook_op_check (OP_GT, invoker_ck_gt, ud);
+ RETVAL = hook_op_check (OP_ENTERSUB, invoker_ck_entersub, ud);
OUTPUT:
RETVAL
@@ -122,7 +76,7 @@ teardown (class, hook)
PREINIT:
userdata_t *ud;
CODE:
- ud = (userdata_t *)hook_op_check_remove (OP_GT, hook);
+ ud = (userdata_t *)hook_op_check_remove (OP_ENTERSUB, hook);
if (ud) {
SvREFCNT_dec (ud->class);
Safefree (ud);
View
40 lib/invoker.pm
@@ -8,22 +8,42 @@ use B::Hooks::EndOfScope;
our $VERSION = "0.29_002";
+use B::Hooks::Parser;
require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);
sub import {
my ($class) = @_;
- my $caller = caller;
+
+ my $parser = B::Hooks::Parser::setup();
+
+ my $linestr = B::Hooks::Parser::get_linestr();
+ my $offset = B::Hooks::Parser::get_linestr_offset();
+ B::Hooks::Parser::inject('use B::OPCheck const => check => \&invoker::_check;');
my $hook = $class->setup;
on_scope_end {
$class->teardown($hook);
+ B::Hooks::Parser::teardown($parser);
};
return;
}
+sub _check {
+ my $op = shift;
+ return unless ref($op->gv) eq 'B::PV';
+
+ my $linestr = B::Hooks::Parser::get_linestr;
+ my $offset = B::Hooks::Parser::get_linestr_offset;
+
+ if (substr($linestr, $offset-2, 3) eq '$->') {
+ substr($linestr, $offset-2, 3, '$-->');
+ B::Hooks::Parser::set_linestr($linestr);
+ }
+}
+
1;
__END__
@@ -68,12 +88,6 @@ The following syntax works:
=item $->$method_name
-=back
-
-The following syntax does not work:
-
-=over
-
=item $->$method_name( .. args ...)
=back
@@ -84,19 +98,15 @@ WARNINGS WARNINGS WARNINGS
This is alpha code. Do not use in production.
-Internally, the module installs a check on the C<< > >> (gt) op. if
-the left operand is C< $- > (some format-related perlvar you probably
-shouldn't be using), it then replaces the optree with an appropriate
-entersub with method_named.
+Internally, the module installs a parser hook to replace C<< $-> >>
+(C<$-> and the gt operator) with $--> (an invocation on the C< $- >
+perlvar. It also injects an entersub hook to replace C< $- > with
+C<$self >.
=head1 BUGS
=over
-=item 1+$->foo will not parse right due to precedences
-
-=item $->foo + $->bar will not parse
-
=back
=head1 TODO
View
4 t/00_compile.t
@@ -1,4 +0,0 @@
-use strict;
-use Test::More tests => 1;
-
-BEGIN { use_ok 'invoker' }
View
6 t/01basic.t
@@ -17,13 +17,14 @@ sub foo {
push @foo, \@_;
}
{
- my $sub = eval q{ sub {
+ # XXX: using string eval blows up b::hooks::parser here
+ my $sub = eval { sub {
use invoker;
sub {
my $self = shift;
$->foo("x", @_);
}
- } };
+ }} ;
ok($sub);
diag $@ if $@;
@@ -35,7 +36,6 @@ sub foo {
is_deeply(\@foo, [[$self, 'x', 1,2],
['submain', $subself, 'x', 1, 2]]);
-
}
{
View
2 t/02context.t
@@ -11,7 +11,7 @@ sub foo {
push @foo, [$c, @_];
}
{
- my $sub = eval q{ sub {
+ my $sub = eval { sub {
use invoker;
sub {
my $self = shift;

0 comments on commit c87a4dd

Please sign in to comment.