[Jifty-commit] r5452 - in Method-Inline: lib/Class/Accessor

[Jifty commits]

Author: clkao
Date: Sat May 10 14:18:37 2008
New Revision: 5452

Modified:
   Method-Inline/bench.pl
   Method-Inline/lib/Class/Accessor/Inline.pm

Log:
a mini data-structure for replacing detachable entersub with helem.


Modified: Method-Inline/bench.pl
==============================================================================
--- Method-Inline/bench.pl	(original)
+++ Method-Inline/bench.pl	Sat May 10 14:18:37 2008
@@ -21,7 +21,7 @@
 }
 
 sub call_cai {
-    $_[0] == 1 ? 1 : 0;
+#    $_[0] == 1 ? 1 : 0;
     $cai->foo();
 }
 

Modified: Method-Inline/lib/Class/Accessor/Inline.pm
==============================================================================
--- Method-Inline/lib/Class/Accessor/Inline.pm	(original)
+++ Method-Inline/lib/Class/Accessor/Inline.pm	Sat May 10 14:18:37 2008
@@ -25,16 +25,39 @@
     my $cv = caller_cv($lv+1);
     my $cv_object = $cv ? svref_2object($cv) : B::main_cv;
     my $caller_op = B::OP::parent_op($lv);
-    warn "===> in update caller before:"; Carp::cluck;
-    B::Concise::compile('', $cv)->(); use B::Concise;
+    my $return_op = B::OP::return_op($lv);
+    my $tree = find_detachable( $caller_op, $return_op );
 
-    $cvme->rewrite($caller_op);
+    $cvme->rewrite($tree);
 
-    warn "===> in update caller"; Carp::cluck;
+    return;
     B::Concise::compile('', $cv)->(); use B::Concise;
 
 }
 
+sub find_detachable {
+    my ( $parent_cop, $return_op ) = @_;
+    my ($parent, $prev, $prevsibling, $thisop);
+    local *B::OP::my_visit = sub { my $op = shift;
+                                   $thisop = $op if ${$op->next} == $$return_op;
+                                   $parent = $op if $op->can('first') && ${$op->first} == $$thisop;
+                                   $prevsibling = $op if ${$op->sibling} == $$thisop;
+                               };
+    B::walkoptree( $_, 'my_visit' ) for $parent_cop->sibling, $parent_cop;
+
+    local *B::OP::my_visit = sub { my $op = shift;
+                                   $prev = $op if ${$op->next} == ${$thisop->first};
+                               };
+    B::walkoptree( $_, 'my_visit' ) for $parent_cop, $parent_cop->sibling;
+
+    return { return => $return_op,
+             thisop => $thisop,
+             parent => $parent,
+             prev => $prev,
+             prevsibling => $prevsibling,
+           };
+}
+
 package Class::Accessor::Inline::accessor;
 use strict;
 use B qw(OPf_WANT_SCALAR OPf_STACKED OPf_KIDS OPf_REF OPpDEREF_HV);
@@ -46,16 +69,8 @@
 
 
 sub rewrite {
-    my ($self, $caller_op) = @_;
-    warn "callerop";
-    $caller_op->dump;
-    my $op = $caller_op->sibling->first;
-    $op->dump;
-    my $exit = $caller_op->sibling->next;
-    warn "...exit";
-    $exit->dump;
-#    $op->dump;
-    $op = $op->sibling;    # exlist, pushmark
+    my ($self, $tree) = @_;
+    my $op = $tree->{thisop}->first->sibling;
 
     my $mname;
     my $key;
@@ -63,7 +78,6 @@
     my $rv2hv = B::UNOP->new( "rv2hv", OPf_WANT_SCALAR|OPf_KIDS|OPf_REF, $self_op);
 
     for ( ; not null $op; $op = $op->sibling ) {
-        warn "===> $op ".$op->name;
         if ($op->name eq 'method_named') {
             $mname = ${$op->sv->object_2svref};
             $key = B::SVOP->new( "const", $op->flags, $mname);
@@ -71,18 +85,20 @@
         else { # with arg, this should be hash assign.
             return; # bail out for now;
         }
-#a        $op->dump;
     };
+    # self-contained floating $helem tree
     my $helem = B::BINOP->new( "helem", OPf_WANT_SCALAR, $rv2hv, $key);
     $self_op->flags( ($self_op->flags | OPpDEREF_HV) & ~OPf_STACKED);
     $self_op->sibling(undef);
-    $helem->dump;
-    $caller_op->next($self_op);
-    $caller_op->sibling($helem);
     $self_op->next($rv2hv);
     $rv2hv->next($key);
     $key->next($helem);
-    $helem->next($exit);
+
+    # reconnect helem to replace $tree
+    $helem->next($tree->{return});
+    $tree->{parent}->first( $helem ) if $tree->{parent};
+    $tree->{prev}->next( $self_op );
+    $tree->{prevsibling}->sibling( $helem ) if $tree->{prevsibling};
 
 
 }