Toby Inkster avatar Toby Inkster committed 0030153 Draft

initial work

Comments (0)

Files changed (16)

+use inc::Module::Package 'RDF 0.009';
+

examples/benchmark.pl

+use Benchmark qw(:all);
+
+{
+	package Local::Foo;
+	use Moose::Role;
+	has foo => (is => 'rw');
+	sub test {
+		my $class = shift;
+		my $self  = $class->new;
+		$self->foo($_) for 0 .. 99;
+	}
+}
+
+{
+	package Local::HashRef::M;
+	use Moose;
+	with 'Local::Foo';
+}
+
+{
+	package Local::HashRef::I;
+	use Moose;
+	with 'Local::Foo';
+	__PACKAGE__->meta->make_immutable;
+}
+
+{
+	package Local::ArrayRef::M;
+	use MooseX::ArrayRef;
+	with 'Local::Foo';
+}
+
+{
+	package Local::ArrayRef::I;
+	use MooseX::ArrayRef;
+	with 'Local::Foo';
+	__PACKAGE__->meta->make_immutable;
+}
+
+cmpthese(10_000, {
+	HashRef_M => sub { Local::HashRef::M::->test },
+	HashRef_I => sub { Local::HashRef::I::->test },
+	ArrayRef_M => sub { Local::ArrayRef::M::->test },
+	ArrayRef_I => sub { Local::ArrayRef::I::->test },
+});

examples/synopsis.pl

+  {
+    package Local::Person;
+    use Moose;
+    has name => (
+      is    => 'ro',
+      isa   => 'Str',
+    );
+    __PACKAGE__->meta->make_immutable;
+  }
+  
+  {
+    package Local::Marriage;
+    use MooseX::ArrayRef;
+    has husband => (
+      is    => 'ro',
+      isa   => 'Local::Person',
+    );
+    has wife => (
+      is    => 'ro',
+      isa   => 'Local::Person',
+    );
+    __PACKAGE__->meta->make_immutable;
+  }
+  
+  my $marriage = Local::Marriage->new(
+    wife      => Local::Person->new(name => 'Alex'),
+    husband   => Local::Person->new(name => 'Sam'),
+  );
+  
+  use Data::Dumper;
+  use Scalar::Util qw(reftype);
+  print reftype($marriage), "\n";   # 'ARRAY'
+  print Dumper($marriage);
+

lib/MooseX/ArrayRef.pm

+package MooseX::ArrayRef;
+
+use 5.008;
+
+BEGIN {
+	$MooseX::ArrayRef::AUTHORITY = 'cpan:TOBYINK';
+	$MooseX::ArrayRef::VERSION   = '0.001';
+}
+
+use Moose ();
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use MooseX::ArrayRef::Meta::Instance ();
+use MooseX::ArrayRef::Meta::Class ();
+
+Moose::Exporter->setup_import_methods(
+	also => [qw( Moose )],
+);
+
+sub init_meta
+{
+	shift;
+	my %p = @_;
+	Moose->init_meta(%p);
+	Moose::Util::MetaRole::apply_metaroles(
+		for             => $p{for_class},
+		class_metaroles => {
+			instance => [qw( MooseX::ArrayRef::Meta::Instance )],
+			class    => [qw( MooseX::ArrayRef::Meta::Class )],
+		},
+	);
+}
+
+[qw( Yeah baby yeah )]
+
+__END__
+
+=head1 NAME
+
+MooseX::ArrayRef - blessed arrayrefs with Moose
+
+=head1 SYNOPSIS
+
+  {
+    package Local::Person;
+    use Moose;
+    has name => (
+      is    => 'ro',
+      isa   => 'Str',
+    );
+    __PACKAGE__->meta->make_immutable;
+  }
+  
+  {
+    package Local::Marriage;
+    use MooseX::ArrayRef;
+    has husband => (
+      is    => 'ro',
+      isa   => 'Local::Person',
+    );
+    has wife => (
+      is    => 'ro',
+      isa   => 'Local::Person',
+    );
+    __PACKAGE__->meta->make_immutable;
+  }
+  
+  my $marriage = Local::Marriage->new(
+    wife      => Local::Person->new(name => 'Alex'),
+    husband   => Local::Person->new(name => 'Sam'),
+  );
+  
+  use Data::Dumper;
+  use Scalar::Util qw(reftype);
+  print reftype($marriage), "\n";   # 'ARRAY'
+  print Dumper($marriage);
+
+
+=head1 DESCRIPTION
+
+Objects implemented with arrayrefs rather than hashrefs are often faster than
+those implemented with hashrefs. Moose's default object implementation is
+hashref based. Can we go faster?
+
+Simply C<< use MooseX::ArrayRef> instead of C<< use Moose >>, but note the
+limitations in the section below.
+
+The current implementation is mostly a proof of concept, but it does mostly
+seem to work.
+
+=begin private
+
+=item init_meta
+
+=end private
+
+=head1 BUGS AND LIMITATIONS
+
+=head2 Limitations on Speed
+
+The accessors for mutable classes not significantly faster than Moose's
+traditional hashref-based objects. For immutable classes, the speed up
+is bigger
+
+               Rate  HashRef_M ArrayRef_M  HashRef_I ArrayRef_I
+  HashRef_M  1016/s         --        -1%       -48%       -55%
+  ArrayRef_M 1031/s         1%         --       -47%       -54%
+  HashRef_I  1953/s        92%        89%         --       -13%
+  ArrayRef_I 2257/s       122%       119%        16%         --
+
+=head2 Limitations on Mutability
+
+Things will probably break if you try to modify classes, add roles, etc "on
+the fly". Make your classes immutable before instantiating even a single
+object.
+
+=head2 Limitations on Inheritance
+
+Inheritance isn't easy to implement with arrayrefs. The current implementation
+suffers from the following limitations:
+
+=over
+
+=item * Single inheritance only.
+
+You cannot extend multiple parent classes.
+
+=item * Inherit from other MooseX::ArrayRef classes only.
+
+A MooseX::ArrayRef class cannot extend a non-MooseX::ArrayRef class.
+Even non-Moose classes which are implemented using arrayrefs. (Of
+course, all Moose classes inherit from L<Moose::Object> too, which
+is just fine.)
+
+=back
+
+Note that delegation (via Moose's C<handles>) is often a good alternative
+to inheritance.
+
+=head2 Issue Tracker
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=MooseX-ArrayRef>.
+
+=head1 SEE ALSO
+
+L<Moose>,
+L<MooseX::GlobRef>,
+L<MooseX::InsideOut>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/MooseX/ArrayRef/Meta/Class.pm

+package MooseX::ArrayRef::Meta::Class;
+
+use Moose::Role;
+
+#has slot_to_index_map => (
+#	is         => 'ro',
+#	isa        => 'HashRef[Num]',
+#	lazy_build => 1,
+#);
+
+has next_index => (
+	is         => 'rw',
+	isa        => 'Num',
+	default    => 0,
+);
+
+has slot_count => (
+	is         => 'rw',
+	isa        => 'Num',
+	lazy_build => 1,
+);
+
+sub slot_to_index_map
+{
+	my $meta = shift;
+	
+	my @supers =
+		reverse
+		grep { not /^Moose::Object$/ }
+		grep { not ref }
+		$meta->superclasses;
+	my %parent = map { $supers[$_] => $_ } 0 .. $#supers;
+	$parent{ $meta->name } = scalar @supers;
+	
+	my @slots =
+		map { $_->slots }
+		sort {
+			$parent{ $a->associated_class->name } <=> $parent{ $b->associated_class->name }
+			or $a->insertion_order <=> $b->insertion_order
+			or $a->name cmp $b->name
+		}
+		$meta->get_all_attributes;
+		
+	+{ map { $slots[$_] => $_ } 0 .. $#slots }
+}
+
+sub slot_index
+{
+	my ($meta, $slot_name) = @_;
+	
+	my $map = $meta->slot_to_index_map;
+	return $map->{$slot_name} if exists $map->{$slot_name};
+	
+	confess "Unknown slot: $slot_name";
+}
+
+sub _build_slot_count
+{
+	my $meta = shift;
+	my $sum  = 0;
+	foreach my $attr ($meta->get_all_attributes)
+	{
+		my @slots = $attr->slots;
+		$sum += scalar @slots;
+	}
+	$sum;
+}
+
+before superclasses => sub
+{
+	my $meta = shift;
+	if (@_)
+	{
+		my @supers = grep { not ref } @_;
+		confess "MooseX::ArrayRef does not support multiple inheritance"
+			if @supers > 1;
+		confess "MooseX::ArrayRef cannot extend a non-MooseX::ArrayRef class"
+			unless Class::MOP::class_of($supers[0])->can('slot_to_index_map');
+	}
+};
+
+1;
+

lib/MooseX/ArrayRef/Meta/Instance.pm

+package MooseX::ArrayRef::Meta::Instance;
+
+use Moose::Role;
+use Moose::Util::MetaRole;
+use Scalar::Util qw( isweak weaken );
+
+use constant EMPTY => \0;
+
+# Delegated certain methods to the metaclass
+BEGIN {
+	no strict 'refs';
+	foreach my $m (qw(slot_index slot_count))
+	{
+		*$m = sub {
+			my $meta = shift;
+			$meta->associated_metaclass->$m(@_);
+		}
+	}
+}
+
+override create_instance => sub {
+	my $meta  = shift;
+	my $class = $meta->associated_metaclass;
+	bless [ (EMPTY) x $meta->slot_count ] => $class->name;
+};
+
+override clone_instance => sub {
+	my ($meta, $instance) = @_;
+	my $class = $meta->associated_metaclass;
+	bless [ @{$instance} ] => $class->name;
+};
+
+override get_slot_value => sub {
+	my ($meta, $instance, $slot_name) = @_;
+	my $value = $instance->[ $meta->slot_index($slot_name) ];
+	return if $value == EMPTY;
+	return $value;
+};
+
+override set_slot_value => sub {
+	my ($meta, $instance, $slot_name, $value) = @_;
+	$instance->[ $meta->slot_index($slot_name) ] = $value;
+};
+
+override initialize_slot => sub { 1 };
+
+override deinitialize_slot => sub {
+	my ($meta, $instance, $slot_name) = @_;
+	$instance->[ $meta->slot_index($slot_name) ] = EMPTY;
+};
+
+override deinitialize_all_slots => sub {
+	my ($meta, $instance) = @_;
+	@$instance = ( (EMPTY) x $meta->slot_count );
+};
+
+override is_slot_initialized => sub {
+	my ($meta, $instance, $slot_name) = @_;
+	$instance->[ $meta->slot_index($slot_name) ] != EMPTY;
+};
+
+override weaken_slot_value => sub {
+	my ($meta, $instance, $slot_name) = @_;
+	weaken $instance->[ $meta->slot_index($slot_name) ];	
+};
+
+override slot_value_is_weak => sub {
+	my ($meta, $instance, $slot_name) = @_;
+	isweak $instance->[ $meta->slot_index($slot_name) ];	
+};
+
+override inline_create_instance => sub {
+	my ($meta, $klass) = @_;
+	my $slots = $meta->slot_count;
+	qq{ bless [ (MooseX::ArrayRef::Meta::Instance::EMPTY) x $slots ], $klass }
+};
+
+override inline_slot_access => sub {
+	my ($meta, $instance, $slot_name) = @_;
+	my $i = $meta->slot_index($slot_name);
+	$instance."->[$i]"
+};
+
+1;

meta/changes.pret

+# This file acts as the project's changelog.
+
+`MooseX-ArrayRef 0.001 cpan:TOBYINK`
+	issued  2012-09-04;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`MooseX-ArrayRef`
+	:programming-language "Perl" ;
+	:shortdesc            "blessed arrayrefs with Moose";
+	:homepage             <https://metacpan.org/release/MooseX-ArrayRef>;
+	:download-page        <https://metacpan.org/release/MooseX-ArrayRef>;
+	:repository           [ a :HgRepository; :browse <https://bitbucket.org/tobyink/p5-moosex-arrayref> ];
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=MooseX-ArrayRef>;
+	:created              2012-09-04;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+
+cpan:TOBYINK
+	foaf:name  "Toby Inkster";
+	foaf:mbox  <mailto:tobyink@cpan.org>.
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`MooseX-ArrayRef`
+	perl_version_from m`MooseX::ArrayRef`;
+	version_from      m`MooseX::ArrayRef`;
+	readme_from       m`MooseX::ArrayRef`;
+	test_requires     p`Test::More 0.61`  .
+
+use Test::More tests => 1;
+BEGIN { use_ok('MooseX::ArrayRef') };
+
+use Test::More tests => 5;
+
+{
+	package Foo;
+	use MooseX::ArrayRef; 
+	has [qw/a c e/] => (is => 'ro');
+}
+
+{
+	package Bar;
+	use Moose::Role;
+	has [qw/b/] => (is => 'ro');
+}
+
+{
+	package Foo::Bar;
+	use MooseX::ArrayRef; extends 'Foo'; with 'Bar';
+	has [qw/d/] => (is => 'ro');
+}
+
+ok defined( Foo::Bar->meta->slot_index($_) ) for 'a'..'e';
+
+note
+	q(slot_to_index_map ),
+	explain(Foo::Bar->meta->slot_to_index_map);
+	
+use Test::More;
+
+{
+	package Foo;
+	use MooseX::ArrayRef;
+	has [qw/a c e/] => (is => 'rw');
+}
+
+{
+	package Bar;
+	use Moose::Role;
+	has [qw/b/] => (is => 'rw', clearer => 'clear_b', predicate => 'has_b');
+}
+
+{
+	package Foo::Bar;
+	use MooseX::ArrayRef; extends 'Foo'; with 'Bar';
+	has [qw/d/] => (is => 'ro');
+	Foo::Bar->meta->make_immutable;
+}
+
+ok(
+	Foo::Bar->meta->is_immutable
+);
+
+my $obj = Foo::Bar->new(
+	a  => 'A',
+	b  => 'B',
+	d  => 'D',
+	e  => 'E',
+);
+
+note q($obj = ), explain($obj);
+
+note q(Foo slot_to_index_map ), explain(Foo->meta->slot_to_index_map);
+note q(Foo::Bar slot_to_index_map ), explain(Foo::Bar->meta->slot_to_index_map);
+
+
+is($obj->d, 'D', '$obj->d');
+is($obj->a, 'A', '$obj->a');
+is($obj->b, 'B', '$obj->b');
+is($obj->e, 'E', '$obj->e');
+
+ok($obj->has_b, 'predicates work');
+
+$obj->b(undef);
+ok($obj->has_b, 'empty slot is dfferent to undef');
+
+$obj->clear_b;
+ok(not($obj->has_b), 'clearers work');
+
+$obj->b('Bee');
+is($obj->b, 'Bee', 'setters work');
+
+my $obj2 = $obj->meta->clone_object($obj, b => 'be');
+is($obj2->a, 'A',  '$obj2->a');
+is($obj2->b, 'be', '$obj2->b');
+
+done_testing();
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use Test::More;
+use Test::Pod::Coverage;
+
+my @modules = qw(MooseX::ArrayRef);
+pod_coverage_ok($_, "$_ is covered") for @modules;
+done_testing(scalar @modules);
+

xt/03meta_uptodate.t

+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok('MooseX-ArrayRef', 'MooseX::ArrayRef');
+
+use Test::EOL;
+all_perl_files_ok();
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.