From: diakopter <diakopter@gmail.com>
Date: Sun, 5 May 2013 09:26:46 +0000 (+0000)
Subject: defer string evals from startup to JIT/lazy. on my machine cuts startup by 9% and... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose.git;a=commitdiff_plain;h=d0efb39cebabfeca0833ed43ea155ce03a1556c4

defer string evals from startup to JIT/lazy. on my machine cuts startup by 9% and make test time by 5.5%
---

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index aa7b8b8..24d50a2 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -102,7 +102,7 @@ sub _generate_accessor_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    return try {
+    my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
         $self->_compile_code([
             'sub {',
                 'if (@_ > 1) {',
@@ -115,6 +115,7 @@ sub _generate_accessor_method_inline {
     catch {
         confess "Could not generate inline accessor because : $_";
     };
+    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
 }
 
 sub _generate_reader_method {
@@ -132,7 +133,7 @@ sub _generate_reader_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    return try {
+    my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
         $self->_compile_code([
             'sub {',
                 'if (@_ > 1) {',
@@ -149,6 +150,7 @@ sub _generate_reader_method_inline {
     catch {
         confess "Could not generate inline reader because : $_";
     };
+    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
 }
 
 sub _inline_throw_error {
@@ -169,7 +171,7 @@ sub _generate_writer_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    return try {
+    my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
         $self->_compile_code([
             'sub {',
                 $attr->_inline_set_value('$_[0]', '$_[1]'),
@@ -179,6 +181,7 @@ sub _generate_writer_method_inline {
     catch {
         confess "Could not generate inline writer because : $_";
     };
+    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
 }
 
 sub _generate_predicate_method {
@@ -194,7 +197,7 @@ sub _generate_predicate_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    return try {
+    my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
         $self->_compile_code([
             'sub {',
                 $attr->_inline_has_value('$_[0]'),
@@ -204,6 +207,7 @@ sub _generate_predicate_method_inline {
     catch {
         confess "Could not generate inline predicate because : $_";
     };
+    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
 }
 
 sub _generate_clearer_method {
@@ -219,7 +223,7 @@ sub _generate_clearer_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    return try {
+    my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
         $self->_compile_code([
             'sub {',
                 $attr->_inline_clear_value('$_[0]'),
@@ -229,6 +233,7 @@ sub _generate_clearer_method_inline {
     catch {
         confess "Could not generate inline clearer because : $_";
     };
+    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
 }
 
 1;
diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index 0b4ef7d..a150dcc 100644
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -100,13 +100,14 @@ sub _generate_constructor_method_inline {
 
     warn join("\n", @source) if $self->options->{debug};
 
-    my $code = try {
+    my $RuNNeR; my $code = bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
         $self->_compile_code(\@source);
     }
     catch {
         my $source = join("\n", @source);
         confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$_";
     };
+    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
 
     return $code;
 }
diff --git a/t/immutable/inline_close_over.t b/t/immutable/inline_close_over.t
index 107258c..44a1edc 100644
--- a/t/immutable/inline_close_over.t
+++ b/t/immutable/inline_close_over.t
@@ -46,6 +46,7 @@ my $can_partialdump = try {
     sub _is_okay_to_close_over {
         my $self = shift;
         my ($thing) = @_;
+        return 1 if ref($thing) eq 'RuNNeR';
 
         match_on_type $thing => (
             'RegexpRef'  => sub { 1 },
@@ -62,6 +63,7 @@ sub close_over_ok {
     my ($package, $method) = @_;
     my $visitor = Test::Visitor->new;
     my $code = $package->meta->find_method_by_name($method)->body;
+    $code = $code->(undef, $code) if ref($code) eq 'RuNNeR';
     $visitor->visit($code);
     if ($visitor->pass) {
         pass("${package}::${method} didn't close over anything complicated");