From: Stevan Little Date: Tue, 14 Nov 2006 16:52:03 +0000 (+0000) Subject: foo X-Git-Tag: 0_18~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose.git;a=commitdiff_plain;h=c8cf9aaaa9bc89f8a889c3c17d163034dc59a410 foo --- diff --git a/Changes b/Changes index d28bc9f..1c08315 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,26 @@ Revision history for Perl extension Moose +0.16 + ~~ NOTE: + ~~ some speed improvements in this release, + ~~ this is only the begining, so stay tuned + + * Moose::Object + - BUILDALL and DEMOLISHALL no longer get + called unless they actually need to be. + This gave us a signifigant speed boost + for the cases when there is no BUILD or + DEMOLISH method present. + + * Moose::Util::TypeConstraints + * Moose::Meta::TypeConstraint + - added an 'optimize_as' option to the + type constraint, which allows for a + hand optimized version of the type + constraint to be used when possible. + - Any internally created type constraints + now provide an optimized version as well. + 0.15 Sun. Nov. 5, 2006 ++ NOTE ++ This version of Moose *must* have Class::MOP 0.36 in order diff --git a/benchmarks/simple_constructor.pl b/benchmarks/simple_constructor.pl new file mode 100644 index 0000000..66c0ac3 --- /dev/null +++ b/benchmarks/simple_constructor.pl @@ -0,0 +1,26 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +my $num_iterations = shift || 100; + +{ + package Foo; + use Moose; + + has 'default' => (is => 'rw', default => 10); + has 'default_sub' => (is => 'rw', default => sub { [] }); + has 'lazy' => (is => 'rw', default => 10, lazy => 1); + has 'required' => (is => 'rw', required => 1); + has 'weak_ref' => (is => 'rw', weak_ref => 1); + has 'type_constraint' => (is => 'rw', isa => 'ArrayRef'); +} + +foreach (0 .. $num_iterations) { + my $foo = Foo->new( + required => 'BAR', + type_constraint => [], + weak_ref => {}, + ); +} \ No newline at end of file diff --git a/benchmarks/type_constraints.pl b/benchmarks/type_constraints.pl index 1c53e6e..a0a6eed 100644 --- a/benchmarks/type_constraints.pl +++ b/benchmarks/type_constraints.pl @@ -20,7 +20,6 @@ all vs. a custom-created type. has 'baz' => (is => 'rw'); has 'bar' => (is => 'rw', isa => 'Foo'); - #has 'boo' => (is => 'rw', isa => type 'CustomFoo' => where { blessed($_) && $_->isa('Foo') }); } my $foo = Foo->new; @@ -32,10 +31,7 @@ cmpthese(200_000, }, 'w_constraint' => sub { $foo->bar($foo); - }, - #'w_custom_constraint' => sub { - # $foo->boo($foo); - #}, + }, } ); diff --git a/lib/Moose.pm b/lib/Moose.pm index 3264473..a72df14 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,7 +4,7 @@ package Moose; use strict; use warnings; -our $VERSION = '0.15'; +our $VERSION = '0.16'; use Scalar::Util 'blessed', 'reftype'; use Carp 'confess'; @@ -34,6 +34,7 @@ use Moose::Util::TypeConstraints; subtype $class => as 'Object' => where { $_->isa($class) } + => optimize_as { blessed($_[0]) && $_[0]->isa($class) } unless find_type_constraint($class); my $meta; diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 7e5d102..d040693 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -9,7 +9,7 @@ use Class::MOP; use Carp 'confess'; use Scalar::Util 'weaken', 'blessed', 'reftype'; -our $VERSION = '0.08'; +our $VERSION = '0.09'; use Moose::Meta::Method::Overriden; @@ -133,25 +133,6 @@ sub get_method_map { return $map; } -#sub find_method_by_name { -# my ($self, $method_name) = @_; -# (defined $method_name && $method_name) -# || confess "You must define a method name to find"; -# # keep a record of what we have seen -# # here, this will handle all the -# # inheritence issues because we are -# # using the &class_precedence_list -# my %seen_class; -# foreach my $class ($self->class_precedence_list()) { -# next if $seen_class{$class}; -# $seen_class{$class}++; -# # fetch the meta-class ... -# my $meta = $self->initialize($class); -# return $meta->get_method($method_name) -# if $meta->has_method($method_name); -# } -#} - ### --------------------------------------------- sub add_attribute { diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm index 0fa004c..307c4bc 100644 --- a/lib/Moose/Meta/Method/Accessor.pm +++ b/lib/Moose/Meta/Method/Accessor.pm @@ -6,7 +6,7 @@ use warnings; use Carp 'confess'; -our $VERSION = '0.01'; +our $VERSION = '0.02'; use base 'Moose::Meta::Method', 'Class::MOP::Method::Accessor'; @@ -86,6 +86,12 @@ sub generate_reader_method_inline { return $sub; } +## normal method generators + +*generate_reader_method = \&generate_reader_method_inline; +*generate_writer_method = \&generate_writer_method_inline; +*generate_accessor_method = \&generate_accessor_method_inline; + ## ... private helpers sub _inline_check_constraint { @@ -222,6 +228,12 @@ role in the optimization strategy we are currently following. =over 4 +=item B + +=item B + +=item B + =item B =item B diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 8d0f28a..518cd29 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -9,7 +9,7 @@ use Sub::Name 'subname'; use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.06'; +our $VERSION = '0.07'; use Moose::Meta::TypeConstraint::Union; @@ -30,6 +30,12 @@ __PACKAGE__->meta->add_attribute('compiled_type_constraint' => ( accessor => '_compiled_type_constraint' )); +__PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => ( + init_arg => 'optimized', + accessor => 'hand_optimized_type_constraint', + predicate => 'has_hand_optimized_type_constraint', +)); + sub new { my $class = shift; my $self = $class->meta->new_object(@_); @@ -46,7 +52,7 @@ sub _collect_all_parents { my @parents; my $current = $self->parent; while (defined $current) { - unshift @parents => $current; + push @parents => $current; $current = $current->parent; } return @parents; @@ -54,6 +60,16 @@ sub _collect_all_parents { sub compile_type_constraint { my $self = shift; + + if ($self->has_hand_optimized_type_constraint) { + my $type_constraint = $self->hand_optimized_type_constraint; + $self->_compiled_type_constraint(sub { + return undef unless $type_constraint->($_[0]); + return 1; + }); + return; + } + my $check = $self->constraint; (defined $check) || confess "Could not compile type constraint '" . $self->name . "' because no constraint check"; @@ -62,7 +78,17 @@ sub compile_type_constraint { # we have a subtype ... # so we gather all the parents in order # and grab their constraints ... - my @parents = map { $_->constraint } $self->_collect_all_parents; + my @parents; + foreach my $parent ($self->_collect_all_parents) { + if ($parent->has_hand_optimized_type_constraint) { + unshift @parents => $parent->hand_optimized_type_constraint; + last; + } + else { + unshift @parents => $parent->constraint; + } + } + # then we compile them to run without # having to recurse as we did before $self->_compiled_type_constraint(subname $self->name => sub { @@ -72,8 +98,7 @@ sub compile_type_constraint { } return undef unless $check->($_[0]); 1; - }); - + }); } else { # we have a type .... @@ -198,6 +223,10 @@ the C will be used to construct a custom error message. =item B +=item B + +=item B + =back =over 4 @@ -225,4 +254,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index e754eb4..22d9f28 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -9,7 +9,7 @@ use metaclass 'Moose::Meta::Class'; use Carp 'confess'; -our $VERSION = '0.06'; +our $VERSION = '0.07'; sub new { my $class = shift; @@ -28,6 +28,7 @@ sub new { } sub BUILDALL { + return unless $_[0]->can('BUILD'); my ($self, $params) = @_; foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) { $method->{code}->($self, $params); @@ -35,6 +36,7 @@ sub BUILDALL { } sub DEMOLISHALL { + return unless $_[0]->can('DEMOLISH'); my $self = shift; foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { $method->{code}->($self); diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 3ca4710..45034a2 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -10,7 +10,7 @@ use Sub::Name 'subname'; use Sub::Exporter; -our $VERSION = '0.05'; +our $VERSION = '0.06'; use Moose (); @@ -29,6 +29,7 @@ use Moose::Util::TypeConstraints; subtype $role => as 'Role' => where { $_->does($role) } + => optimize_as { blessed($_[0]) && $_[0]->can('does') && $_[0]->does($role) } unless find_type_constraint($role); my $meta; diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 3df5fba..b67c426 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -9,13 +9,13 @@ use Scalar::Util 'blessed'; use B 'svref_2object'; use Sub::Exporter; -our $VERSION = '0.09'; +our $VERSION = '0.10'; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; my @exports = qw/ - type subtype as where message + type subtype as where message optimize_as coerce from via enum find_type_constraint @@ -59,8 +59,17 @@ sub unimport { Data::Dumper::Dumper(\%TYPES); } - sub _create_type_constraint ($$$;$) { - my ($name, $parent, $check, $message) = @_; + sub _create_type_constraint ($$$;$$) { + my $name = shift; + my $parent = shift; + my $check = shift;; + + my ($message, $optimized); + for (@_) { + $message = $_->{message} if exists $_->{message}; + $optimized = $_->{optimized} if exists $_->{optimized}; + } + my $pkg_defined_in = scalar(caller(1)); ($TYPES{$name}->[0] eq $pkg_defined_in) || confess "The type constraint '$name' has already been created " @@ -71,6 +80,7 @@ sub unimport { parent => $parent, constraint => $check, message => $message, + optimized => $optimized, ); $TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name; return $constraint; @@ -113,8 +123,8 @@ sub type ($$) { _create_type_constraint($name, undef, $check); } -sub subtype ($$;$$) { - unshift @_ => undef if scalar @_ <= 2; +sub subtype ($$;$$$) { + unshift @_ => undef if scalar @_ <= 2; goto &_create_type_constraint; } @@ -127,7 +137,9 @@ sub as ($) { $_[0] } sub from ($) { $_[0] } sub where (&) { $_[0] } sub via (&) { $_[0] } -sub message (&) { $_[0] } + +sub message (&) { +{ message => $_[0] } } +sub optimize_as (&) { +{ optimized => $_[0] } } sub enum ($;@) { my ($type_name, @values) = @_; @@ -149,33 +161,61 @@ type 'Item' => where { 1 }; # base-type subtype 'Undef' => as 'Item' => where { !defined($_) }; subtype 'Defined' => as 'Item' => where { defined($_) }; -subtype 'Bool' => as 'Item' => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }; - -subtype 'Value' => as 'Defined' => where { !ref($_) }; -subtype 'Ref' => as 'Defined' => where { ref($_) }; +subtype 'Bool' + => as 'Item' + => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }; -subtype 'Str' => as 'Value' => where { 1 }; - -subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) }; -subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ }; - -subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' }; -subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' }; -subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' }; -subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' }; -subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' }; -subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' }; +subtype 'Value' + => as 'Defined' + => where { !ref($_) } + => optimize_as { defined($_[0]) && !ref($_[0]) }; + +subtype 'Ref' + => as 'Defined' + => where { ref($_) } + => optimize_as { ref($_[0]) }; + +subtype 'Str' + => as 'Value' + => where { 1 } + => optimize_as { defined($_[0]) && !ref($_[0]) }; + +subtype 'Num' + => as 'Value' + => where { Scalar::Util::looks_like_number($_) } + => optimize_as { !ref($_[0]) && Scalar::Util::looks_like_number($_[0]) }; + +subtype 'Int' + => as 'Num' + => where { "$_" =~ /^-?[0-9]+$/ } + => optimize_as { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }; + +subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as { ref($_[0]) eq 'SCALAR' }; +subtype 'ArrayRef' => as 'Ref' => where { ref($_) eq 'ARRAY' } => optimize_as { ref($_[0]) eq 'ARRAY' }; +subtype 'HashRef' => as 'Ref' => where { ref($_) eq 'HASH' } => optimize_as { ref($_[0]) eq 'HASH' }; +subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as { ref($_[0]) eq 'CODE' }; +subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as { ref($_[0]) eq 'Regexp' }; +subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as { ref($_[0]) eq 'GLOB' }; # NOTE: # scalar filehandles are GLOB refs, # but a GLOB ref is not always a filehandle -subtype 'FileHandle' => as 'GlobRef' => where { Scalar::Util::openhandle($_) }; +subtype 'FileHandle' + => as 'GlobRef' + => where { Scalar::Util::openhandle($_) } + => optimize_as { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) }; # NOTE: # blessed(qr/.../) returns true,.. how odd -subtype 'Object' => as 'Ref' => where { blessed($_) && blessed($_) ne 'Regexp' }; +subtype 'Object' + => as 'Ref' + => where { blessed($_) && blessed($_) ne 'Regexp' } + => optimize_as { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }; -subtype 'Role' => as 'Object' => where { $_->can('does') }; +subtype 'Role' + => as 'Object' + => where { $_->can('does') } + => optimize_as { blessed($_[0]) && $_[0]->can('does') }; 1; @@ -347,6 +387,8 @@ This is just sugar for the type constraint construction syntax. This is just sugar for the type constraint construction syntax. +=item B + =back =head2 Type Coercion Constructors