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

[Jifty commits]

Author: clkao
Date: Sat May 10 12:23:25 2008
New Revision: 5442

Added:
   Method-Inline/bench.pl
   Method-Inline/lib/
   Method-Inline/lib/Class/
   Method-Inline/lib/Class/Accessor/
   Method-Inline/lib/Class/Accessor/Inline.pm
   Method-Inline/t/
   Method-Inline/t/simple.t

Log:
first cut of Method::Inline

Added: Method-Inline/bench.pl
==============================================================================
--- (empty file)
+++ Method-Inline/bench.pl	Sat May 10 12:23:25 2008
@@ -0,0 +1,47 @@
+package FooCA;
+use base 'Class::Accessor';
+__PACKAGE__->mk_accessors(qw(foo));
+
+package FooCAF;
+use base 'Class::Accessor::Fast';
+__PACKAGE__->mk_accessors(qw(foo));
+
+package FooCAI;
+use base 'Class::Accessor::Inline';
+__PACKAGE__->mk_accessors(qw(foo));
+
+package main;
+
+my $ca = FooCA->new( { foo => 'bar' });
+my $caf = FooCAF->new( { foo => 'bar' });
+my $cai = FooCAI->new( { foo => 'bar' });
+
+sub call_caf {
+    $caf->foo();
+}
+
+sub call_cai {
+    $_[0] == 1 ? 1 : 0;
+    $cai->foo();
+}
+
+sub call_ca {
+    $ca->foo()
+}
+
+sub call_cad {
+    $cai->{foo};
+}
+
+
+warn call_cai();
+warn call_cai();
+
+use Benchmark 'cmpthese';
+cmpthese(-2, { ca => sub { call_ca() },
+               caf => sub { call_caf() },
+               cai => sub { call_cai() },
+               cad => sub { call_cad() },
+             });
+
+B::Concise::compile('', 'call_cai', 'call_cad')->(); use B::Concise;

Added: Method-Inline/lib/Class/Accessor/Inline.pm
==============================================================================
--- (empty file)
+++ Method-Inline/lib/Class/Accessor/Inline.pm	Sat May 10 12:23:25 2008
@@ -0,0 +1,90 @@
+package Class::Accessor::Inline;
+use strict;
+use B qw(svref_2object);
+use B::Utils;
+use B::Generate;
+use Devel::Caller 'caller_cv';
+use base 'Class::Accessor::Fast';
+
+sub make_accessor {
+    my ($class, $field) = @_;
+
+    return bless sub {
+        Class::Accessor::Inline->update_caller;
+        return $_[0]->{$field} if @_ == 1;
+        return $_[0]->{$field} = $_[1] if @_ == 2;
+        return (shift)->{$field} = \@_;
+    }, 'Class::Accessor::Inline::accessor';
+
+}
+
+sub update_caller {
+    my ($class) = shift;
+    my $lv = 1;
+    my $cvme = caller_cv($lv);
+    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;
+
+    $cvme->rewrite($caller_op);
+
+    warn "===> in update caller"; Carp::cluck;
+    B::Concise::compile('', $cv)->(); use B::Concise;
+
+}
+
+package Class::Accessor::Inline::accessor;
+use strict;
+use B qw(OPf_WANT_SCALAR OPf_STACKED OPf_KIDS OPf_REF OPpDEREF_HV);
+
+sub null {
+    my $op = shift;
+    return B::class($op) eq "NULL";
+}
+
+
+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 $mname;
+    my $key;
+    my $self_op = $op; $op = $op->sibling;
+    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);
+        }
+        else { # with arg, this should be hash assign.
+            return; # bail out for now;
+        }
+#a        $op->dump;
+    };
+    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);
+
+
+}
+
+1

Added: Method-Inline/t/simple.t
==============================================================================
--- (empty file)
+++ Method-Inline/t/simple.t	Sat May 10 12:23:25 2008
@@ -0,0 +1,23 @@
+use Test::More tests => 2;
+use ok 'Class::Accessor::Inline';
+
+package Foo;
+use base 'Class::Accessor::Inline';
+__PACKAGE__->mk_accessors(qw(foo bar));
+
+package main;
+
+
+my $foo = Foo->new( { foo => 'orz' });
+
+sub hate {
+    $foo->foo;;
+}
+
+
+
+warn hate();
+$foo->foo('newval');
+
+warn hate();
+warn hate();