From: Yuval Kogman Date: Sat, 15 Jul 2006 18:30:01 +0000 (+0000) Subject: Iterator update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=99919a86b42b9836a73ebb66f91ffa810aa2038a;p=gitmo%2FClass-MOP.git Iterator update --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 9b06820..f32f15a 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -163,6 +163,24 @@ Class::MOP::Attribute->meta->add_attribute( )) ); +## Class::MOP::Iterator + +=pod + +Class::MOP::Iterator->meta->add_attribute( + Class::MOP::Attribute->new('generator' => ( + accessor => 'generator', + )), +); + +Class::MOP::Iterator->meta->add_attribute( + Class::MOP::Attribute->new('predicate' => ( + accessor => 'predicate', + )), +); + +=cut + # NOTE: (meta-circularity) # This should be one of the last things done @@ -196,6 +214,7 @@ Class::MOP::Class ->meta->make_immutable(inline_constructor => 0); Class::MOP::Attribute->meta->make_immutable(inline_constructor => 0); Class::MOP::Method ->meta->make_immutable(inline_constructor => 0); Class::MOP::Instance ->meta->make_immutable(inline_constructor => 0); +Class::MOP::Iterator ->meta->make_immutable(inline_constructor => 0); 1; diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 5b91132..4898036 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -315,9 +315,9 @@ sub superclasses { my @superclasses = @{$self->name . '::ISA'}; - wantarray + return ( wantarray ? @superclasses - : Class::MOP::Iterator->from_list( @superclasses ); + : Class::MOP::Iterator->from_list( @superclasses ) ); } sub class_precedence_list { @@ -644,12 +644,12 @@ sub remove_attribute { sub get_attribute_list { my $self = shift; my @attr_names = keys %{$self->get_attribute_map}; - wantarray ? @attr_names : Class::MOP::Iterator->from_list(@attr_names); + return ( wantarray ? @attr_names : Class::MOP::Iterator->from_list(@attr_names) ); } sub compute_all_applicable_attributes { my $self = shift; - my @attrs; + # keep a record of what we have seen # here, this will handle all the # inheritence issues because we are @@ -661,6 +661,8 @@ sub compute_all_applicable_attributes { # names are diff. # while this is true for construction, it's not true for accessors + # perhaps it should be told how to make attrs mask eachother off? + my $i = Class::MOP::Iterator->flatten( Class::MOP::Iterator->map( sub { @@ -681,7 +683,8 @@ sub compute_all_applicable_attributes { ), ), ); - return @attrs; + + return ( wantarray ? $i->all : $i ); } sub find_attribute_by_name { diff --git a/lib/Class/MOP/Class/Immutable.pm b/lib/Class/MOP/Class/Immutable.pm index 0a95028..acc8c11 100644 --- a/lib/Class/MOP/Class/Immutable.pm +++ b/lib/Class/MOP/Class/Immutable.pm @@ -7,6 +7,8 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'looks_like_number'; +use Class::MOP::Iterator; + our $VERSION = '0.01'; use base 'Class::MOP::Class'; @@ -130,10 +132,11 @@ sub _generate_slot_initializer { # cached methods -sub get_meta_instance { (shift)->{'___get_meta_instance'} } -sub class_precedence_list { @{(shift)->{'___class_precedence_list'}} } -sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} } -sub get_mutable_metaclass_name { (shift)->{'___original_class'} } +sub _i { wantarray ? @_ : Class::MOP::Iterator->from_list(@_) } +sub get_meta_instance { (shift)->{'___get_meta_instance'} } +sub class_precedence_list { _i(@{(shift)->{'___class_precedence_list'}}) } +sub compute_all_applicable_attributes { _i(@{(shift)->{'___compute_all_applicable_attributes'}}) } +sub get_mutable_metaclass_name { (shift)->{'___original_class'} } 1; diff --git a/lib/Class/MOP/Iterator.pm b/lib/Class/MOP/Iterator.pm index dda6f2e..9efabab 100644 --- a/lib/Class/MOP/Iterator.pm +++ b/lib/Class/MOP/Iterator.pm @@ -5,6 +5,11 @@ package Class::MOP::Iterator; use strict; use warnings; +use Carp 'confess'; +use Scalar::Util 'blessed', 'reftype', 'weaken'; + +our $VERSION = "0.01"; + use base 'Class::MOP::Module'; sub meta { @@ -29,7 +34,6 @@ sub from_list { return $class->new( generator => sub { shift @list }, predicate => sub { scalar(@list) }, - __list => \@list, ); } @@ -80,13 +84,13 @@ sub map { return $class->new( predicate => sub { $iter->check_predicate }, generator => sub { - unless ( $iter->is_done ) { + if ( $iter->check_predicate ) { my $next = $iter->next; local $_ = $next; return $map->($next); + } else { + return; } - - return }, ); } @@ -96,12 +100,6 @@ sub grep { my $iter = ( ( @iters == 1 ) ? $iters[0] : $class->concat(@iters) ); - use Data::Dumper; - $Data::Dumper::Deparse = 1; - #warn "got iter to filter: ". Dumper($iter, $filter); - - die Carp::longmess unless $iter->isa(__PACKAGE__); - my $have_next; # always know if there's a next match for predicate my $next_value; # if we had to look ahead, this is where we keep it @@ -140,7 +138,7 @@ sub flatten { my ( $class, @iters ) = @_; my $iter_of_iters = ( ( @iters == 1 ) ? $iters[0] : $class->concat(@iters) ); - + my $next_iter; my $get_next_iter = sub { while ( !$next_iter or $next_iter->is_done ) { @@ -221,6 +219,101 @@ methods so that they may replace theselves. A nice alternative would be for someone to write L. +=head1 METHODS + +=head2 Constructors + +=over 4 + +=item new %options + +Takes an options hash which must contain the fields C and +C. + +C must return the next item in the iterator, and C must +return true if there are any items remaining. + +Both code refs accept the iterator as the invocant, and may invoke methods on +it. + +=item concat @iters + +This is a bit like saying C<< map { @$_ } @array_of_arrays >>. It returns an +iterator that will return all the values from all it's sub iterators. + +=item cons $item, $iter + +Creates an iterator that will first return $item, and then every element in +$iter. + +=item grep $filter, @iters + +Creates an iterator over all the iterms that for which C<< $filter->($item) >> +returns true. + +The item is both in C<$_> and in C<$_[0]> for C<$filter>. + +=item map $sub, @iters + +Creates an iterator of consisting of C<< $sub->( $item ) >> for every item in +C<@iters>. + +The item is both in C<$_> and in C<$_[0]> for C<$sub>. + +=item from_list @list + +Creates an iterator from a list of items. + +Every item will be returned, akin to calling C repeatedly. + +=item flatten @iters_of_iters + +Accepts iterators whose items are themselves iterators, and flattens the +output. + +=back + +=head2 Instance methods + +=over 4 + +=item next + +Return the next item in the iterator. + +=item all + +Deplete the iterator, returning all the items. + +=item is_done + +Returns whether or not the iterator is depleted. + +=item check_predicate + +The inverse of is_done. + +=item generator + +Set or get the generator code ref. + +=item predicate + +Set or get the predicate code ref. + +=back + +=head2 Introspection + +=over 4 + +=item meta + +Returns the L instance which is related with the class of +the invocant. + +=back + =cut diff --git a/t/000_load.t b/t/000_load.t index 0dd8492..b80bcd5 100644 --- a/t/000_load.t +++ b/t/000_load.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 14; +use Test::More tests => 15; BEGIN { use_ok('Class::MOP'); @@ -22,6 +22,7 @@ my %METAS = ( 'Class::MOP::Class' => Class::MOP::Class->meta, 'Class::MOP::Method' => Class::MOP::Method->meta, 'Class::MOP::Instance' => Class::MOP::Instance->meta, + 'Class::MOP::Iterator' => Class::MOP::Iterator->meta, ); ok($_->is_immutable(), '... ' . $_->name . ' is immutable') for values %METAS; @@ -37,6 +38,7 @@ is_deeply( Class::MOP::Attribute->meta, Class::MOP::Class->meta, Class::MOP::Instance->meta, + Class::MOP::Iterator->meta, Class::MOP::Method->meta, Class::MOP::Module->meta, Class::MOP::Package->meta, @@ -49,8 +51,9 @@ is_deeply( Class::MOP::Attribute Class::MOP::Class Class::MOP::Instance + Class::MOP::Iterator Class::MOP::Method Class::MOP::Module Class::MOP::Package / ], - '... got all the metaclass names'); \ No newline at end of file + '... got all the metaclass names');