Perl6-Pugs
view release on metacpan or search on metacpan
ext/Perl6-Value-List/lib/Perl6/Value/List.pm view on Meta::CPAN
use v6-alpha;
# Perl6::Value::List - implementation of Perl6 'List' class in Perl6
=begin ChangeLog
2005-08-10
* New methods List.flatten(), is_lazy(), from_coro( $sub )
* Factored Perl6::Value::List out of the Array package
=cut
# TODO - sync with Perl5 version:
# * Separate from_num_range() and from_range() constructors.
# - from_num_range() is a numeric range. It accepts a 'step' value.
# - from_range() is a generic range for strings, etc. It accepts a 'celems' closure.
# Both constructors are just new() wrappers.
# * grep(), map() don't depend on coroutines
# * Removed pair() - this module does not have access to the Pair constructor
#
# TODO - is_contiguous() should test if $step == 1
# TODO - test flatten(), is_lazy(), error messages
# TODO - emit error message if attempting to flatten() an infinite list
# TODO - does zip() has additional parameters?
# TODO - document unsupported operations: join, reduce, sort - call fail()
# TODO - check grep() syntax
# TODO - provide a better default stringify - see Span.pm
# TODO - fix elems() in from_range(), when start/end are Str - 'a'..'z'
# - add tests
# TODO - rewrite ops using closures (instead of coro)
# TODO - reuse map() to write ops
# Things that will be solved by the compiler:
# - keys/kv/pairs/values with indexes (S29) --> array slice
# - lists of junctions --> junctions of lists
# - list concatenation --> array concatenation
# ---------
class Perl6::Value::List {
does List;
has Code $.cstart;
has Code $.cend;
has Code $.celems;
has Code $.cis_infinite;
has Code $.cis_contiguous;
has Code $.cstringify;
has Bool $.is_lazy;
submethod BUILD () {
$.cis_infinite //= sub { &($.celems)() == Inf },
$.cis_contiguous //= sub { Bool::False },
$.cstringify //= sub { &($.cstart)() ~ '....' ~ &($.cend)() },
$.is_lazy //= Bool::True,
$.celems //= ( defined $.cstart || defined $.cend ) ??
sub { Inf } !!
sub { 0 };
$.cstart //= sub {};
$.cend //= sub {};
}
method start () { &($.cstart)() } # == shift
method end () { &($.cend)() } # == pop
method elems () { &($.celems)() }
method is_infinite ( $self: ) { &($.cis_infinite)() }
method is_contiguous ( $self: ) { &($.cis_contiguous)() }
method to_str ( $self: ) { &($.cstringify)() }
# method clone ( $self: ) { $self } --- auto generated
method to_ref ( $self: ) { $self }
method to_bit ( $self: ) { $self.elems > 0 }
method to_num ( $self: ) { $self.elems }
method to_list ( $self: ) { $self }
# method is_lazy ( $self: ) { ... } --- auto generated
method flatten ( $self: ) {
my $ret = $array;
# TODO - add tests for this error message
# fail "can't instantiate an infinite list"
# if $ret.is_infinite;
my @list;
while $ret.elems { &*push(@list, $ret.shift); }
$self.from_single( @list );
}
method from_range ( $class: $start is copy, $end is copy, $step? ) {
$class.new(
cstart => sub {
my $r = $start;
if ( defined $step ) { $start += $step } else { $start++ };
return $r;
},
cend => sub {
my $r = $end;
if ( defined $step ) {
# XXX - this should use modulus, etc.
$end -= $step
}
else {
$end--
};
return $r;
},
celems => sub {
return $end - $start + 1 unless defined $step;
return int(( $end - $start + 1 ) / $step);
},
cis_infinite => sub { return $start == -Inf || $end == Inf },
cis_contiguous => sub { $step == -1 | 1 | undef },
);
}
method from_single ( $class: *@list is copy ) {
$class.new( cstart => sub{ @list.shift },
cend => sub{ @list.pop },
celems => sub{ +@list },
is_lazy => Bool::False );
}
method from_coro ( $class: $start ) {
my $size = Inf;
$class.new(
cstart => sub {
my $r = &($start)();
$size = 0 unless defined $r;
return $r;
},
cend => sub {},
celems => sub { $size },
cis_infinite => sub { $size == Inf },
cis_contiguous => sub { Bool::False },
);
}
# --- list operations ---
method reverse ( $array: ) {
my $ret = $array;
Perl6::Value::List.new(
cstart => $ret.cend,
cend => $ret.cstart,
celems => $ret.celems,
cis_infinite => $ret.cis_infinite,
cis_contiguous => $ret.cis_contiguous,
cstringify => $ret.cstringify,
);
}
method grep ( $array: Code $code ) {
my $ret = $array;
Perl6::Value::List.new(
cstart => coro {
my $x = $ret.shift // yield;
yield $x if &$code($x);
return;
},
cend => coro {
my $x = $ret.pop // yield;
yield $x if &$code($x);
return;
},
# TODO - signal end of data using 'elems()'
);
}
method map ( $array: Code $code ) {
my $ret = $array;
Perl6::Value::List.new(
cstart => coro {
my @ret;
my $x = $ret.shift // yield;
&*unshift(@ret: &$code($x));
yield @ret.shift while @ret;
return;
},
cend => coro {
my @ret;
my $x = $ret.pop // yield;
&*push(@ret, &$code($x));
yield @ret.pop while @ret;
return;
},
# TODO - signal end of data using 'elems()'
)
}
method uniq ( $array: ) {
my %seen = ();
my $ret = $array;
Perl6::Value::List.new(
cstart => coro {
my $x = $ret.shift // yield;
unless %seen{$x} {
%seen{$x} = Bool::True;
yield $x;
}
return;
},
cend => coro {
my $x = $ret.pop // yield;
unless %seen{$x} {
%seen{$x} = Bool::True;
yield $x;
}
return;
},
# TODO - signal end of data using 'elems()'
)
}
method kv ( $array: ) {
my $ret = $array;
my $count = 0;
Perl6::Value::List.new(
cstart => coro {
my $x = $ret.shift // yield;
yield $count++;
yield $x;
return;
},
celems => sub { $ret.elems + $ret.elems },
)
}
method pairs ( $array: ) {
my $ret = $array;
my $count = 0;
Perl6::Value::List.new(
cstart => coro {
my $x = $ret.shift // yield;
my $pair = $count => $x;
yield $pair;
$count++;
},
celems => sub { $ret.elems },
)
}
method keys ( $array: ) {
my $ret = $array;
my $count = 0;
Perl6::Value::List.new(
cstart => coro {
my $x = $ret.shift // yield;
yield $count++;
},
celems => sub { $ret.elems },
)
}
method values ( $array: ) {
$array
}
method zip ( $array: Array @list ) {
# TODO: implement zip parameters
# TODO: implement count = max( @lists.elems )
my @lists = ( $array, @list );
Perl6::Value::List.new(
cstart => coro {
my @x;
my $count = 0;
# TODO - rewrite this checking 'elems()'
# XXX - the list would normally stop after the first 'undef'
for @lists -> $xx {
&*push(@x, [$xx.shift]);
}
if defined any(@x) {
for @lists -> $xx {
yield &*shift(@x);
}
}
else {
yield;
}
}
)
}
method shift () { self.start if self.elems }
method pop () { self.end if self.elems }
} # end class Perl6::Value::List
multi *shift ( Perl6::Value::List $l ) is export { $l.start if $l.elems }
multi *pop ( Perl6::Value::List $l ) is export { $l.end if $l.elems }
=kwid
= NAME
Perl6::Value::List - implementation of Perl6 'List' class in Perl6
= SYNOPSIS
my $list = Perl6::Value::List.from_range( start => 10, end => 20 );
my $list = Perl6::Value::List.new( start => coro mylist2 { yield $_ for 1..3; yield; } );
= DESCRIPTION
A lazy list created from coroutines or subs.
= CONSTRUCTORS
- `new( ... )`
= METHODS
- `shift`
- `pop`
- `reverse`
= AUTHOR
Flavio S. Glock, <fglock@gmail.com>
= COPYRIGHT
Copyright (c) 2005, Flavio S. Glock. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
( run in 0.771 second using v1.01-cache-2.11-cpan-364913b4093 )