From b05f6f00187bf9619eca3f9f95a08a44a536b054 Mon Sep 17 00:00:00 2001 From: Paul Chaignon Date: Sat, 6 Jun 2015 18:49:36 +0200 Subject: [PATCH] Test for the new heuristic definitions --- samples/Perl6/List.pm | 699 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 699 insertions(+) create mode 100644 samples/Perl6/List.pm diff --git a/samples/Perl6/List.pm b/samples/Perl6/List.pm new file mode 100644 index 00000000..4e1ec47f --- /dev/null +++ b/samples/Perl6/List.pm @@ -0,0 +1,699 @@ +# for our tantrums +my class X::TypeCheck { ... } +my role Supply { ... } + +my sub combinations($n, $k) { + my @result; + my @stack; + + return ([],) unless $k; + + @stack.push(0); + gather while @stack { + my $index = @stack - 1; + my $value = @stack.pop; + + while $value < $n { + @result[$index++] = $value++; + @stack.push($value); + if $index == $k { + take [@result]; + $value = $n; # fake a last + } + } + } +} + +my sub permutations(Int $n) { + $n == 1 ?? ( [0,] ) !! + gather for ^$n -> $i { + my @i = grep none($i), ^$n; + take [$i, @i[@$_]] for permutations($n - 1); + } +} + +my class List does Positional { # declared in BOOTSTRAP + # class List is Iterable is Cool + # has Mu $!items; # VM's array of our reified elements + # has Mu $!flattens; # true if this list flattens its parcels + # has Mu $!nextiter; # iterator for generating remaining elements + + method new(|) { + my Mu $args := nqp::p6argvmarray(); + nqp::shift($args); + + nqp::p6list($args, self.WHAT, Mu); + } + + multi method Bool(List:D:) { self.gimme(1).Bool } + multi method Int(List:D:) { self.elems } + multi method end(List:D:) { self.elems - 1 } + multi method Numeric(List:D:) { self.elems } + multi method Str(List:D:) { self.join(' ') } + + # Pretend we're a Match assuming we're a list of Matches + method to() { self.elems ?? self[self.end].to !! Nil } + method from() { self.elems ?? self[0].from !! Nil } + + method fmt($format = '%s', $separator = ' ') { + self.map({ .fmt($format) }).join($separator); + } + + method flat() { self.flattens + ?? self + !! nqp::p6list(nqp::list(self), List, Bool::True) + } + method list() { self } + method lol() { + self.gimme(0); + my Mu $rpa := nqp::clone($!items); + nqp::push($rpa, $!nextiter) if $!nextiter.defined; + nqp::p6list($rpa, LoL, Mu); + } + + method flattens() { $!flattens } + + method Capture() { + self.gimme(*); + my $cap := nqp::create(Capture); + nqp::bindattr($cap, Capture, '$!list', $!items); + $cap + } + + method Parcel() { + my Mu $rpa := nqp::clone(nqp::p6listitems(self)); + nqp::push($rpa, $!nextiter) if $!nextiter.defined; + nqp::p6parcel($rpa, Any); + } + + method Supply(List:D:) { Supply.from-list(self) } + + multi method at_pos(List:D: int \pos) is rw { + fail X::OutOfRange.new(:what,:got(pos),:range<0..Inf>) + if nqp::islt_i(pos,0); + self.exists_pos(pos) ?? nqp::atpos($!items,pos) !! Nil; + } + multi method at_pos(List:D: Int:D \pos) is rw { + my int $pos = nqp::unbox_i(pos); + fail X::OutOfRange.new(:what,:got(pos),:range<0..Inf>) + if nqp::islt_i($pos,0); + self.exists_pos($pos) ?? nqp::atpos($!items,$pos) !! Nil; + } + + method eager() { self.gimme(*); self } + + method elems() { + return 0 unless self.DEFINITE; + return nqp::elems(nqp::p6listitems(self)) unless nqp::defined($!nextiter); + # Get as many elements as we can. If gimme stops before + # reaching the end of the list, assume the list is infinite. + my $n := self.gimme(*); + nqp::defined($!nextiter) ?? Inf !! $n + } + + multi method exists_pos(List:D: int $pos) { + return False if nqp::islt_i($pos,0); + self.gimme($pos + 1); + nqp::p6bool( + nqp::not_i(nqp::isnull(nqp::atpos($!items,$pos))) + ); + } + multi method exists_pos(List:D: Int:D $pos) { + return False if $pos < 0; + self.gimme($pos + 1); + nqp::p6bool( + nqp::not_i(nqp::isnull(nqp::atpos($!items,nqp::unbox_i($pos)))) + ); + } + + method gimme($n, :$sink) { + return unless self.DEFINITE; + # loop through iterators until we have at least $n elements + my int $count = nqp::elems(nqp::p6listitems(self)); + if nqp::istype($n, Whatever) || nqp::istype($n, Num) && nqp::istrue($n == Inf) { + while $!nextiter.DEFINITE && !$!nextiter.infinite { + $!nextiter.reify(*, :$sink); + $count = nqp::elems($!items); + } + } + else { + my int $target = $n.Int; + while nqp::isconcrete($!nextiter) && $count < $target { + $!nextiter.reify($target - $count, :$sink); + $count = nqp::elems($!items); + } + } + + # return the number of elements we have now + $count + } + + multi method infinite(List:D:) { $!nextiter.infinite } + + method iterator() { + # Return a reified ListIter containing our currently reified elements + # and any subsequent iterator. + my $iter := nqp::create(ListIter); + nqp::bindattr($iter, ListIter, '$!nextiter', $!nextiter); + nqp::bindattr($iter, ListIter, '$!reified', self.Parcel()); + $iter; + } + + method munch($n is copy) { + $n = 0 if $n < 0; + $n = self.gimme($n) if nqp::not_i(nqp::istype($n, Int)) + || nqp::not_i(nqp::islist($!items)) + || nqp::islt_i(nqp::elems($!items), nqp::unbox_i($n)); + nqp::p6parcel( + nqp::p6shiftpush(nqp::list(), $!items, nqp::unbox_i($n)), + Any + ) + } + + proto method pick(|) { * } + multi method pick() { + fail "Cannot .pick from infinite list" if self.infinite; + my $elems = self.elems; + $elems ?? self.at_pos($elems.rand.floor) !! Nil; + } + multi method pick($n is copy) { + fail "Cannot .pick from infinite list" if self.infinite; + ## We use a version of Fisher-Yates shuffle here to + ## replace picked elements with elements from the end + ## of the list, resulting in an O(n) algorithm. + my $elems = self.elems; + return unless $elems; + $n = Inf if nqp::istype($n, Whatever); + $n = $elems if $n > $elems; + return self.at_pos($elems.rand.floor) if $n == 1; + my Mu $rpa := nqp::clone($!items); + my $i; + my Mu $v; + gather while $n > 0 { + $i = nqp::rand_I(nqp::decont($elems), Int); + $elems--; $n--; + $v := nqp::atpos($rpa, nqp::unbox_i($i)); + # replace selected element with last unpicked one + nqp::bindpos($rpa, nqp::unbox_i($i), + nqp::atpos($rpa, nqp::unbox_i($elems))); + take-rw $v; + } + } + + method pop() is parcel { + my $elems = self.gimme(*); + fail 'Cannot .pop from an infinite list' if $!nextiter.defined; + $elems > 0 + ?? nqp::pop($!items) + !! fail 'Element popped from empty list'; + } + + method shift() is parcel { + # make sure we have at least one item, then shift+return it + nqp::islist($!items) && nqp::existspos($!items, 0) || self.gimme(1) + ?? nqp::shift($!items) + !! fail 'Element shifted from empty list'; + } + + my &list_push = multi method push(List:D: *@values) { + fail 'Cannot .push an infinite list' if @values.infinite; + nqp::p6listitems(self); + my $elems = self.gimme(*); + fail 'Cannot .push to an infinite list' if $!nextiter.DEFINITE; + + # push is always eager + @values.gimme(*); + + # need type checks? + my $of := self.of; + + unless $of =:= Mu { + X::TypeCheck.new( + operation => '.push', + expected => $of, + got => $_, + ).throw unless nqp::istype($_, $of) for @values; + } + + nqp::splice($!items, + nqp::getattr(@values, List, '$!items'), + $elems, 0); + + self; + } + + multi method push(List:D: \value) { + if nqp::iscont(value) || nqp::not_i(nqp::istype(value, Iterable)) && nqp::not_i(nqp::istype(value, Parcel)) { + $!nextiter.DEFINITE && self.gimme(*); + fail 'Cannot .push to an infinite list' if $!nextiter.DEFINITE; + nqp::p6listitems(self); + nqp::istype(value, self.of) + ?? nqp::push($!items, nqp::assign(nqp::p6scalarfromdesc(nqp::null), value)) + !! X::TypeCheck.new( + operation => '.push', + expected => self.of, + got => value, + ).throw; + self + } + else { + list_push(self, value) + } + } + + multi method unshift(List:D: \value) { + if nqp::iscont(value) || !(nqp::istype(value, Iterable) || nqp::istype(value, Parcel)) { + nqp::p6listitems(self); + value.gimme(*) if nqp::istype(value, List); # fixes #121994 + nqp::istype(value, self.of) + ?? nqp::unshift($!items, my $ = value) + !! X::TypeCheck.new( + operation => '.push', + expected => self.of, + got => value, + ).throw; + self + } + else { + callsame(); + } + } + + multi method unshift(List:D: *@values) { + fail 'Cannot .unshift an infinite list' if @values.infinite; + nqp::p6listitems(self); + + # don't bother with type checks + my $of := self.of; + if ( $of =:= Mu ) { + nqp::unshift($!items, @values.pop) while @values; + } + + # we must check types + else { + while @values { + my $value := @values.pop; + if nqp::istype($value, $of) { + nqp::unshift($!items, $value); + } + + # huh? + else { + X::TypeCheck.new( + operation => '.unshift', + expected => $of, + got => $value, + ).throw; + } + } + } + + self + } + + method plan(List:D: |args) { + nqp::p6listitems(self); + my $elems = self.gimme(*); + fail 'Cannot add plan to an infinite list' if $!nextiter.defined; + +# # need type checks? +# my $of := self.of; +# +# unless $of =:= Mu { +# X::TypeCheck.new( +# operation => '.push', +# expected => $of, +# got => $_, +# ).throw unless nqp::istype($_, $of) for @values; +# } + + nqp::bindattr(self, List, '$!nextiter', nqp::p6listiter(nqp::list(args.list), self)); + Nil; + } + + proto method roll(|) { * } + multi method roll() { + fail "Cannot .roll from infinite list" if self.infinite; + my $elems = self.elems; + $elems ?? self.at_pos($elems.rand.floor) !! Nil; + } + multi method roll($n is copy) { + fail "Cannot .roll from infinite list" if self.infinite; + my $elems = self.elems; + return unless $elems; + $n = Inf if nqp::istype($n, Whatever); + return self.at_pos($elems.rand.floor) if $n == 1; + + gather while $n > 0 { + take nqp::atpos($!items, nqp::unbox_i($elems.rand.floor.Int)); + $n--; + } + } + + method reverse() { + self.gimme(*); + fail 'Cannot .reverse from an infinite list' if $!nextiter.defined; + my Mu $rev := nqp::list(); + my Mu $orig := nqp::clone($!items); + nqp::push($rev, nqp::pop($orig)) while $orig; + my $rlist := nqp::create(self.WHAT); + nqp::bindattr($rlist, List, '$!items', $rev); + $rlist; + } + + method rotate(Int $n is copy = 1) { + self.gimme(*); + fail 'Cannot .rotate an infinite list' if $!nextiter.defined; + my $items = nqp::p6box_i(nqp::elems($!items)); + return self if !$items; + + $n %= $items; + return self if $n == 0; + + my Mu $res := nqp::clone($!items); + if $n > 0 { + nqp::push($res, nqp::shift($res)) while $n--; + } + elsif $n < 0 { + nqp::unshift($res, nqp::pop($res)) while $n++; + } + my $rlist := nqp::create(self.WHAT); + nqp::bindattr($rlist, List, '$!items', $res); + $rlist; + } + + method splice($offset = 0, $size?, *@values) { + self.gimme(*); + my $o = $offset; + my $s = $size; + my $elems = self.elems; + $o = $o($elems) if nqp::istype($o, Callable); + X::OutOfRange.new( + what => 'offset argument to List.splice', + got => $offset, + range => (0..^self.elems), + ).fail if $o < 0; + $s //= self.elems - ($o min $elems); + $s = $s(self.elems - $o) if nqp::istype($s, Callable); + X::OutOfRange.new( + what => 'size argument to List.splice', + got => $size, + range => (0..^(self.elems - $o)), + ).fail if $s < 0; + + my @ret = self[$o..($o + $s - 1)]; + nqp::splice($!items, + nqp::getattr(@values.eager, List, '$!items'), + $o.Int, $s.Int); + @ret; + } + + method sort($by = &infix:) { + fail 'Cannot .sort an infinite list' if self.infinite; #MMD? + + # Instead of sorting elements directly, we sort a Parcel of + # indices from 0..^$list.elems, then use that Parcel as + # a slice into self. This is for historical reasons: on + # Parrot we delegate to RPA.sort. The JVM implementation + # uses a Java collection sort. MoarVM has its sort algorithm + # implemented in NQP. + + # nothing to do here + my $elems := self.elems; + return self if $elems < 2; + + # Range is currently optimized for fast Parcel construction. + my $index := Range.new(0, $elems, :excludes-max).reify(*); + my Mu $index_rpa := nqp::getattr($index, Parcel, '$!storage'); + + # if $by.arity < 2, then we apply the block to the elements + # for sorting. + if ($by.?count // 2) < 2 { + my $list = self.map($by).eager; + nqp::p6sort($index_rpa, -> $a, $b { $list.at_pos($a) cmp $list.at_pos($b) || $a <=> $b }); + } + else { + my $list = self.eager; + nqp::p6sort($index_rpa, -> $a, $b { $by($list.at_pos($a), $list.at_pos($b)) || $a <=> $b }); + } + self[$index]; + } + + multi method ACCEPTS(List:D: $topic) { self } + + method uniq(|c) { + DEPRECATED('unique', |<2014.11 2015.11>); + self.unique(|c); + } + + proto method unique(|) {*} + multi method unique() { + my $seen := nqp::hash(); + my str $target; + gather for @.list { + $target = nqp::unbox_s($_.WHICH); + unless nqp::existskey($seen, $target) { + nqp::bindkey($seen, $target, 1); + take $_; + } + } + } + multi method unique( :&as!, :&with! ) { + my @seen = "should be Mu, but doesn't work in settings :-(" + my Mu $target; + gather for @.list { + $target = &as($_); + if first( { with($target,$_) }, @seen ) =:= Nil { + @seen.push($target); + take $_; + } + }; + } + multi method unique( :&as! ) { + my $seen := nqp::hash(); + my str $target; + gather for @.list { + $target = &as($_).WHICH; + unless nqp::existskey($seen, $target) { + nqp::bindkey($seen, $target, 1); + take $_; + } + } + } + multi method unique( :&with! ) { + nextwith() if &with === &[===]; # use optimized version + + my @seen; # should be Mu, but doesn't work in settings :-( + my Mu $target; + gather for @.list { + $target := $_; + if first( { with($target,$_) }, @seen ) =:= Nil { + @seen.push($target); + take $_; + } + } + } + + my @secret; + proto method squish(|) {*} + multi method squish( :&as!, :&with = &[===] ) { + my $last = @secret; + my str $which; + gather for @.list { + $which = &as($_).Str; + unless with($which,$last) { + $last = $which; + take $_; + } + } + } + multi method squish( :&with = &[===] ) { + my $last = @secret; + gather for @.list { + unless with($_,$last) { + $last = $_; + take $_; + } + } + } + + proto method rotor(|) {*} + multi method rotor(1, 0) { self } + multi method rotor($elems = 2, $overlap = 1) { + X::OutOfRange.new( + what => 'Overlap argument to List.rotor', + got => $overlap, + range => (0 .. $elems - 1), + ).fail unless 0 <= $overlap < $elems; + X::OutOfRange.new( + what => 'Elements argument to List.rotor', + got => $elems, + range => (0 .. *), + ).fail unless 0 <= $elems; + + my $finished = 0; + gather while $finished + $overlap < self.gimme($finished + $elems) { + take item self[$finished ..^ $finished + $elems]; + $finished += $elems - $overlap + } + } + + multi method gist(List:D:) { + @(self).map( -> $elem { + given ++$ { + when 101 { '...' } + when 102 { last } + default { $elem.gist } + } + } ).join: ' '; + } + multi method perl(List:D \SELF:) { + self.gimme(*); + self.Parcel.perl ~ '.list' + ~ (nqp::iscont(SELF) ?? '.item' !! '') + } + + method REIFY(Parcel \parcel, Mu \nextiter) { + nqp::splice($!items, nqp::getattr(parcel, Parcel, '$!storage'), + nqp::elems($!items), 0); + nqp::bindattr(self, List, '$!nextiter', nextiter); + parcel + } + + method FLATTENABLE_LIST() { self.gimme(*); $!items } + method FLATTENABLE_HASH() { nqp::hash() } + + multi method DUMP(List:D: :$indent-step = 4, :%ctx?) { + return DUMP(self, :$indent-step) unless %ctx; + + my $flags := ("\x221e" if self.infinite); + my Mu $attrs := nqp::list(); + nqp::push($attrs, '$!flattens'); + nqp::push($attrs, $!flattens ); + nqp::push($attrs, '$!items' ); + nqp::push($attrs, $!items ); + nqp::push($attrs, '$!nextiter'); + nqp::push($attrs, $!nextiter ); + self.DUMP-OBJECT-ATTRS($attrs, :$indent-step, :%ctx, :$flags); + } + + multi method keys(List:D:) { + self.values.map: { (state $)++ } + } + multi method kv(List:D:) { + gather for self.values { + take (state $)++; + take-rw $_; + } + } + multi method values(List:D:) { + my Mu $rpa := nqp::clone(nqp::p6listitems(self)); + nqp::push($rpa, $!nextiter) if $!nextiter.defined; + nqp::p6list($rpa, List, self.flattens); + } + multi method pairs(List:D:) { + self.values.map: {; (state $)++ => $_ } + } + + method reduce(List: &with) { + fail('can only reduce with arity 2') + unless &with.arity <= 2 <= &with.count; + return unless self.DEFINITE; + my \vals = self.values; + my Mu $val = vals.shift; + $val = with($val, $_) for vals; + $val; + } + + method sink() { + self.gimme(*, :sink) if self.DEFINITE && $!nextiter.DEFINITE; + Nil; + } + + # this is a remnant of a previous implementation of .push(), which + # apparently is used by LoL. Please remove when no longer necessary. + method STORE_AT_POS(Int \pos, Mu \v) is rw { + nqp::bindpos($!items, nqp::unbox_i(pos), v) + } + + proto method combinations($?) {*} + multi method combinations( Int $of ) { + ([self[@$_]] for combinations(self.elems, $of).eager) + } + multi method combinations( Range $of = 0 .. * ) { + gather for @$of { + last if $_ > self.elems; + take self.combinations($_); + } + } + + method permutations() { + # need block on Moar because of RT#121830 + gather { take [self[@$_]] for permutations(self.elems).eager } + } +} + +sub eager(|) { + nqp::p6parcel(nqp::p6argvmarray(), Any).eager +} + +sub flat(|) { + nqp::p6list(nqp::p6argvmarray(), List, Bool::True) +} + +sub list(|) { + nqp::p6list(nqp::p6argvmarray(), List, Mu) +} + +proto sub infix:(|) { * } +multi sub infix:() { fail "No zero-arg meaning for infix:" } +multi sub infix:(Mu \x) {x } +multi sub infix:(Mu \x, $n is copy, :$thunked!) { + $n = nqp::p6bool(nqp::istype($n, Whatever)) ?? Inf !! $n.Int; + GatherIter.new({ take x.() while --$n >= 0; }, :infinite($n == Inf)).list +} +multi sub infix:(Mu \x, Whatever, :$thunked!) { + GatherIter.new({ loop { take x.() } }, :infinite(True)).flat +} +multi sub infix:(Mu \x, Whatever) { + GatherIter.new({ loop { take x } }, :infinite(True)).flat +} +multi sub infix:(Mu \x, $n) { + my int $size = $n.Int; + + my Mu $rpa := nqp::list(); + if $size > 0 { + nqp::setelems($rpa, $size); + nqp::setelems($rpa, 0); + + $size = $size + 1; + nqp::push($rpa,x) while $size = $size - 1; + } + + nqp::p6parcel($rpa, Any); +} + +proto sub pop(@) {*} +multi sub pop(@a) { @a.pop } + +proto sub shift(@) {*} +multi sub shift(@a) { @a.shift } + +proto sub unshift(|) {*} +multi sub unshift(\a, \elem) { a.unshift: elem } +multi sub unshift(\a, *@elems) { a.unshift: @elems } + +proto sub push(|) {*} +multi sub push(\a, \elem) { a.push: elem } +multi sub push(\a, *@elems) { a.push: @elems } + +sub reverse(*@a) { @a.reverse } +sub rotate(@a, Int $n = 1) { @a.rotate($n) } +sub reduce (&with, *@list) { @list.reduce(&with) } +sub splice(@arr, $offset = 0, $size?, *@values) { + @arr.splice($offset, $size, @values) +} + +multi sub infix:(@a, @b) { (@a Zcmp @b).first(&prefix:) || @a <=> @b } + +# vim: ft=perl6 expandtab sw=4