[Jifty-commit] r5454 - Method-Inline/lib/Class/Accessor

[Jifty commits]

Author: clkao
Date: Sat May 10 16:02:07 2008
New Revision: 5454

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

Log:
inline mutator.

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 16:02:07 2008
@@ -27,6 +27,7 @@
     my $caller_op = B::OP::parent_op($lv);
     my $return_op = B::OP::return_op($lv);
     my $tree = find_detachable( $caller_op, $return_op );
+#    B::Concise::compile('', $cv)->(); use B::Concise;
 
     $cvme->rewrite($tree);
 
@@ -37,39 +38,56 @@
 
 sub find_detachable {
     my ( $parent_cop, $return_op ) = @_;
-    my ($parent, $prev, $prevsibling, $thisop);
+    my ($parent, $prev, $prevsibling, $thisop, $entry);
     local *B::OP::my_visit = sub { my $op = shift;
                                    $thisop = $op if ${$op->next} == $$return_op;
+                               };
+    B::walkoptree( $_, 'my_visit' ) for $parent_cop->sibling;
+
+    local *B::OP::my_visit = sub { my $op = shift;
                                    $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;
 
+    my $visited;
+    local *B::OP::my_visit = sub { my $op = shift;
+                                   $visited->{$$op} = 1;
+                               };
+    Carp::confess unless $thisop;
+    B::walkoptree( $_, 'my_visit' ) for $thisop;
+
     local *B::OP::my_visit = sub { my $op = shift;
-                                   $prev = $op if ${$op->next} == ${$thisop->first};
+                                   if (!$visited->{$$op} && $visited->{${$op->next}}) {
+                                       $entry = $op->next;
+                                       $prev = $op;
+                                   }
                                };
     B::walkoptree( $_, 'my_visit' ) for $parent_cop, $parent_cop->sibling;
 
     return { return => $return_op,
-             thisop => $thisop,
-             parent => $parent,
-             prev => $prev,
-             prevsibling => $prevsibling,
-           };
+        parent_cop  => $parent_cop,
+        thisop      => $thisop,
+        parent      => $parent,
+        prev        => $prev,
+        prevsibling => $prevsibling,
+        entry       => $entry,
+        sibling     => $thisop->sibling->isa('B::NULL') ? undef : $thisop->sibling,
+    };
 }
 
 package Class::Accessor::Inline::accessor;
 use strict;
-use B qw(OPf_WANT_SCALAR OPf_STACKED OPf_KIDS OPf_REF OPpDEREF_HV);
+use B qw(OPf_WANT_SCALAR OPf_STACKED OPf_KIDS OPf_REF OPpDEREF_HV OPpCONST_BARE);
 
 sub null {
     my $op = shift;
     return B::class($op) eq "NULL";
 }
 
-
 sub rewrite {
     my ($self, $tree) = @_;
+
     my $op = $tree->{thisop}->first->sibling;
 
     my $mname;
@@ -77,15 +95,24 @@
     my $self_op = $op; $op = $op->sibling;
     my $rv2hv = B::UNOP->new( "rv2hv", OPf_WANT_SCALAR|OPf_KIDS|OPf_REF, $self_op);
 
+    my $valop;
+    my $method_op;
     for ( ; not null $op; $op = $op->sibling ) {
         if ($op->name eq 'method_named') {
+            $method_op = $op;
             $mname = ${$op->sv->object_2svref};
-            $key = B::SVOP->new( "const", $op->flags, $mname);
+            $key = B::SVOP->new( "const", 64, $mname);
         }
         else { # with arg, this should be hash assign.
-            return; # bail out for now;
+            $valop = $op;
         }
     };
+
+    my $valtree;
+    if ($valop) {
+        $valtree = Class::Accessor::Inline::find_detachable($tree->{parent_cop}, $method_op);
+    }
+
     # 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);
@@ -94,12 +121,31 @@
     $rv2hv->next($key);
     $key->next($helem);
 
-    # 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};
-
+    if ($valop) {
+        my $sassign = B::BINOP->new( "sassign", OPf_WANT_SCALAR|OPf_KIDS|OPf_STACKED, $helem, $valop);
+        $sassign->next($tree->{return});
+        $sassign->next($tree->{sibling}) if $tree->{sibling};
+
+        $helem->next($sassign);
+        $valtree->{thisop}->next($self_op);
+
+        $tree->{prev}->next( $valtree->{entry} );
+        $tree->{prevsibling}->sibling( $sassign ) if $tree->{prevsibling};
+
+    }
+    else {
+#        for (keys %$tree) {
+#            next unless $tree->{$_};
+#            warn "=== $_: @{[ $tree->{$_}->name ]} ( @{[ $tree->{$_}->seq ]}) ";
+#        }
+        # reconnect helem to replace $tree
+        $helem->next($tree->{return});
+        $helem->sibling($tree->{sibling}) if $tree->{sibling};
+
+        $tree->{parent}->first( $helem ) if $tree->{parent};
+        $tree->{prev}->next( $self_op );
+        $tree->{prevsibling}->sibling( $helem ) if $tree->{prevsibling};
+    }
 
 }