From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 11 Nov 2010 01:34:17 +0000 (-0600)
Subject: make inlining a bit more easily extensible
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5e5102f19ccb1dc52b290577b0363e97dacbd5b3;p=gitmo%2FClass-MOP.git

make inlining a bit more easily extensible
---

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index d0cf234..bbcf98b 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -255,38 +255,91 @@ sub set_initial_value {
 }
 
 sub set_value { shift->set_raw_value(@_) }
-sub get_value { shift->get_raw_value(@_) }
 
 sub set_raw_value {
-    my ($self, $instance, $value) = @_;
+    my $self = shift;
+    my ($instance, $value) = @_;
+
+    my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
+    return $mi->set_slot_value($instance, $self->name, $value);
+}
+
+sub _inline_set_value {
+    my $self = shift;
+    return $self->_inline_instance_set(@_) . ';';
+}
 
-    Class::MOP::Class->initialize(ref($instance))
-                     ->get_meta_instance
-                     ->set_slot_value($instance, $self->name, $value);
+sub _inline_instance_set {
+    my $self = shift;
+    my ($instance, $value) = @_;
+
+    my $mi = $self->associated_class->get_meta_instance;
+    return $mi->inline_set_slot_value($instance, $self->name, $value);
 }
 
+sub get_value { shift->get_raw_value(@_) }
+
 sub get_raw_value {
-    my ($self, $instance) = @_;
+    my $self = shift;
+    my ($instance) = @_;
 
-    Class::MOP::Class->initialize(ref($instance))
-                     ->get_meta_instance
-                     ->get_slot_value($instance, $self->name);
+    my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
+    return $mi->get_slot_value($instance, $self->name);
+}
+
+sub _inline_get_value {
+    my $self = shift;
+    return $self->_inline_instance_get(@_) . ';';
+}
+
+sub _inline_instance_get {
+    my $self = shift;
+    my ($instance) = @_;
+
+    my $mi = $self->associated_class->get_meta_instance;
+    return $mi->inline_get_slot_value($instance, $self->name);
 }
 
 sub has_value {
-    my ($self, $instance) = @_;
+    my $self = shift;
+    my ($instance) = @_;
 
-    Class::MOP::Class->initialize(ref($instance))
-                     ->get_meta_instance
-                     ->is_slot_initialized($instance, $self->name);
+    my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
+    return $mi->is_slot_initialized($instance, $self->name);
+}
+
+sub _inline_has_value {
+    my $self = shift;
+    return $self->_inline_instance_has(@_) . ';';
+}
+
+sub _inline_instance_has {
+    my $self = shift;
+    my ($instance) = @_;
+
+    my $mi = $self->associated_class->get_meta_instance;
+    return $mi->inline_is_slot_initialized($instance, $self->name);
 }
 
 sub clear_value {
-    my ($self, $instance) = @_;
+    my $self = shift;
+    my ($instance) = @_;
+
+    my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
+    return $mi->deinitialize_slot($instance, $self->name);
+}
 
-    Class::MOP::Class->initialize(ref($instance))
-                     ->get_meta_instance
-                     ->deinitialize_slot($instance, $self->name);
+sub _inline_clear_value {
+    my $self = shift;
+    return $self->_inline_instance_clear(@_) . ';';
+}
+
+sub _inline_instance_clear {
+    my $self = shift;
+    my ($instance) = @_;
+
+    my $mi = $self->associated_class->get_meta_instance;
+    return $mi->inline_deinitialize_slot($instance, $self->name);
 }
 
 ## load em up ...
@@ -401,40 +454,6 @@ sub install_accessors {
 
 }
 
-sub inline_get {
-    my $self = shift;
-    my ($instance) = @_;
-
-    return $self->associated_class->get_meta_instance->inline_get_slot_value(
-        $instance, $self->name );
-}
-
-sub inline_set {
-    my $self = shift;
-    my ( $instance, $value ) = @_;
-
-    return $self->associated_class->get_meta_instance->inline_set_slot_value(
-        $instance, $self->name, $value );
-}
-
-sub inline_has {
-    my $self = shift;
-    my ($instance) = @_;
-
-    return
-        $self->associated_class->get_meta_instance
-        ->inline_is_slot_initialized( $instance, $self->name );
-}
-
-sub inline_clear {
-    my $self = shift;
-    my ($instance) = @_;
-
-    return
-        $self->associated_class->get_meta_instance
-        ->inline_deinitialize_slot( $instance, $self->name );
-}
-
 1;
 
 __END__
diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 08bcbd1..5464f8f 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -91,137 +91,138 @@ sub _initialize_body {
 ## generators
 
 sub _generate_accessor_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
-        $attr->get_value($_[0]);
-    };
-}
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
-sub _generate_reader_method {
-    my $attr = (shift)->associated_attribute;
     return sub {
-        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+        if (@_ >= 2) {
+            $attr->set_value($_[0], $_[1]);
+        }
         $attr->get_value($_[0]);
     };
 }
 
-
-sub _generate_writer_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->set_value($_[0], $_[1]);
-    };
-}
-
-sub _generate_predicate_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->has_value($_[0])
-    };
-}
-
-sub _generate_clearer_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->clear_value($_[0])
-    };
-}
-
-## Inline methods
-
 sub _generate_accessor_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my $code = try {
+    return try {
         $self->_compile_code([
             'sub {',
-                $attr->inline_set('$_[0]', '$_[1]'),
-                    'if scalar(@_) == 2;',
-                $attr->inline_get('$_[0]') . ';',
+                'if (@_ >= 2) {',
+                    $attr->_inline_set_value('$_[0]', '$_[1]'),
+                '}',
+                $attr->_inline_get_value('$_[0]'),
             '}',
         ]);
     }
     catch {
         confess "Could not generate inline accessor because : $_";
     };
+}
+
+sub _generate_reader_method {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
-    return $code;
+    return sub {
+        confess "Cannot assign a value to a read-only accessor"
+            if @_ > 1;
+        $attr->get_value($_[0]);
+    };
 }
 
 sub _generate_reader_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my $code = try {
+    return try {
         $self->_compile_code([
             'sub {',
                 'confess "Cannot assign a value to a read-only accessor"',
                     'if @_ > 1;',
-                $attr->inline_get('$_[0]') . ';',
+                $attr->_inline_get_value('$_[0]'),
             '}',
         ]);
     }
     catch {
         confess "Could not generate inline reader because : $_";
     };
+}
 
-    return $code;
+sub _generate_writer_method {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    return sub {
+        $attr->set_value($_[0], $_[1]);
+    };
 }
 
 sub _generate_writer_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my $code = try {
+    return try {
         $self->_compile_code([
             'sub {',
-                $attr->inline_set('$_[0]', '$_[1]') . ';',
+                $attr->_inline_set_value('$_[0]', '$_[1]'),
             '}',
         ]);
     }
     catch {
         confess "Could not generate inline writer because : $_";
     };
+}
+
+sub _generate_predicate_method {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
-    return $code;
+    return sub {
+        $attr->has_value($_[0])
+    };
 }
 
 sub _generate_predicate_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my $code = try {
+    return try {
         $self->_compile_code([
             'sub {',
-                $attr->inline_has('$_[0]') . ';',
+                $attr->_inline_has_value('$_[0]'),
             '}',
         ]);
     }
     catch {
         confess "Could not generate inline predicate because : $_";
     };
+}
 
-    return $code;
+sub _generate_clearer_method {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    return sub {
+        $attr->clear_value($_[0])
+    };
 }
 
 sub _generate_clearer_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my $code = try {
+    return try {
         $self->_compile_code([
             'sub {',
-                $attr->inline_clear('$_[0]') . ';',
+                $attr->_inline_clear_value('$_[0]'),
             '}',
         ]);
     }
     catch {
         confess "Could not generate inline clearer because : $_";
     };
-
-    return $code;
 }
 
 1;
diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index 687aed6..3755a4e 100644
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -143,22 +143,22 @@ sub _generate_slot_initializer {
     if (defined(my $init_arg = $attr->init_arg)) {
         my @source = (
             'if (exists $params->{\'' . $init_arg . '\'}) {',
-                $attr->inline_set(
+                $attr->_inline_set_value(
                     '$instance', '$params->{\'' . $init_arg . '\'}'
-                ) . ';',
+                ),
             '}',
         );
         if (defined $default) {
             push @source, (
                 'else {',
-                    $attr->inline_set('$instance', $default) . ';',
+                    $attr->_inline_set_value('$instance', $default),
                 '}',
             );
         }
         return @source;
     }
     elsif (defined $default) {
-        return ($attr->inline_set('$instance', $default) . ';');
+        return $attr->_inline_set_value('$instance', $default);
     }
     else {
         return ();
diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t
index 112b9c0..57819e0 100644
--- a/t/014_attribute_introspection.t
+++ b/t/014_attribute_introspection.t
@@ -62,10 +62,14 @@ use Class::MOP;
         install_accessors
         remove_accessors
 
-        inline_get
-        inline_set
-        inline_has
-        inline_clear
+        _inline_get_value
+        _inline_set_value
+        _inline_has_value
+        _inline_clear_value
+        _inline_instance_get
+        _inline_instance_set
+        _inline_instance_has
+        _inline_instance_clear
 
         _new
     );