From: Dave Rolsky Date: Sun, 26 Sep 2010 16:27:58 +0000 (-0500) Subject: Handle uninlinable instance in native trait code generation X-Git-Tag: 1.15~66 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=54e259f6b6600d1ab46019c49d0117e520aa2330;p=gitmo%2FMoose.git Handle uninlinable instance in native trait code generation --- diff --git a/lib/Moose/Meta/Attribute/Native/Trait.pm b/lib/Moose/Meta/Attribute/Native/Trait.pm index 190abb0..ee44d6d 100644 --- a/lib/Moose/Meta/Attribute/Native/Trait.pm +++ b/lib/Moose/Meta/Attribute/Native/Trait.pm @@ -89,6 +89,7 @@ around '_make_delegation_method' => sub { name => $handle_name, package_name => $self->associated_class->name, attribute => $self, + is_inline => 1, curried_arguments => \@curried_args, root_types => [ $self->_root_types ], ); diff --git a/lib/Moose/Meta/Method/Accessor/Native.pm b/lib/Moose/Meta/Method/Accessor/Native.pm index a57e5ff..62cde0f 100644 --- a/lib/Moose/Meta/Method/Accessor/Native.pm +++ b/lib/Moose/Meta/Method/Accessor/Native.pm @@ -68,16 +68,6 @@ sub _initialize_body { return; } -sub _eval_environment { - my $self = shift; - - my $env = $self->SUPER::_eval_environment; - - $env->{'@curried'} = $self->curried_arguments; - - return $env; -} - sub _inline_curried_arguments { my $self = shift; @@ -127,4 +117,48 @@ sub _maximum_arguments { undef } sub _inline_check_arguments { q{} } +sub _inline_get { + my ( $self, $instance ) = @_; + + return $self->_slot_access_can_be_inlined + ? $self->SUPER::_inline_get($instance) + : "${instance}->\$reader"; +} + +sub _inline_store { + my ( $self, $instance, $value ) = @_; + + return $self->_slot_access_can_be_inlined + ? $self->SUPER::_inline_store( $instance, $value ) + : "${instance}->\$writer($value)"; +} + +sub _eval_environment { + my $self = shift; + + my $env = $self->SUPER::_eval_environment(@_); + + $env->{'@curried'} = $self->curried_arguments; + + return $env if $self->_slot_access_can_be_inlined; + + my $reader = $self->associated_attribute->get_read_method_ref; + $reader = $reader->body if blessed $reader; + + $env->{'$reader'} = \$reader; + + my $writer = $self->associated_attribute->get_write_method_ref; + $writer = $writer->body if blessed $writer; + + $env->{'$writer'} = \$writer; + + return $env; +} + +sub _slot_access_can_be_inlined { + my $self = shift; + + return $self->is_inline && $self->_instance_is_inlinable; +} + 1; diff --git a/lib/Moose/Meta/Method/Accessor/Native/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Writer.pm index c140acb..f44aac4 100644 --- a/lib/Moose/Meta/Method/Accessor/Native/Writer.pm +++ b/lib/Moose/Meta/Method/Accessor/Native/Writer.pm @@ -144,7 +144,7 @@ sub _inline_set_new_value { my $self = shift; return $self->SUPER::_inline_store(@_) - if $self->_value_needs_copy; + if $self->_value_needs_copy || !$self->_slot_access_can_be_inlined; return $self->_inline_optimized_set_new_value(@_); }