Mercurial > hg > Others > Rakudo
view src/core.c/ShapedArray.pm6 @ 0:c341f82e7ad7 default tip
Rakudo branch in cr.ie.u-ryukyu.ac.jp
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 26 Dec 2019 16:50:27 +0900 |
parents | |
children |
line wrap: on
line source
# this is actually part of the Array class my role ShapedArray does Rakudo::Internals::ShapedArrayCommon { has $.shape; # Handle dimensions > 3 or more indices than dimensions. # If dimensions <= 3, then custom AT-POS should have caught # correct number of indices already. multi method AT-POS(::?CLASS:D: **@indices) is raw { nqp::stmts( (my \reified := nqp::getattr(self,List,'$!reified')), nqp::if( nqp::islt_i( @indices.elems, # reifies (my int $numdims = nqp::numdimensions(reified)) ), X::NYI.new( feature => "Partially dimensioned views of shaped arrays").throw, nqp::stmts( (my \indices := nqp::getattr(@indices,List,'$!reified')), (my \idxs := nqp::list_i), nqp::while( # native index list nqp::isge_i(($numdims = nqp::sub_i($numdims,1)),0), nqp::push_i(idxs,nqp::shift(indices)) ), (my \element := nqp::ifnull( nqp::atposnd(reified,idxs), # found it nqp::p6scalarfromdesc( ContainerDescriptor::BindArrayPosND.new( nqp::getattr(self, Array, '$!descriptor'), reified, idxs ) ) )), nqp::if( nqp::elems(indices), element.AT-POS(|@indices), # index further element # we're done! ) ) ) ) } multi method ASSIGN-POS(::?CLASS:D: **@indices-value) { nqp::stmts( (my \value := @indices-value.pop), # reifies (my \indices := nqp::getattr(@indices-value,List,'$!reified')), (my \reified := nqp::getattr(self,List,'$!reified')), nqp::if( nqp::isge_i( (my int $numind = nqp::elems(indices)), (my int $numdims = nqp::numdimensions(reified)) ), nqp::stmts( # more than enough indices (my \idxs := nqp::list_i), nqp::while( # native index list nqp::isge_i(($numdims = nqp::sub_i($numdims,1)),0), nqp::push_i(idxs,nqp::shift(indices)) ), (my \element := nqp::ifnull( nqp::atposnd(reified,idxs), # found it! nqp::bindposnd(reified,idxs, # create new scalar nqp::p6scalarfromdesc( nqp::getattr(self,Array,'$!descriptor'))) )), nqp::if( nqp::elems(indices), element.AT-POS(|@indices-value), # go deeper element # this is it ) = value # and assign ), X::NotEnoughDimensions.new( # too few indices operation => 'assign to', got-dimensions => $numind, needed-dimensions => $numdims ).throw ) ) } multi method EXISTS-POS(::?CLASS:D: **@indices --> Bool:D) { nqp::hllbool( nqp::stmts( (my int $numind = @indices.elems), # reifies (my \indices := nqp::getattr(@indices,List,'$!reified')), (my \reified := nqp::getattr(self,List,'$!reified')), (my \dims := nqp::dimensions(reified)), (my int $i = -1), nqp::if( nqp::isge_i( $numind, (my int $numdims = nqp::numdimensions(reified)), ), nqp::stmts( # same or more indices (my \idxs := nqp::list_i), nqp::while( nqp::islt_i( # still indices left ($i = nqp::add_i($i,1)), $numind) && nqp::islt_i( # within range? (my $idx = nqp::shift(indices)), nqp::atpos_i(dims,$i)), nqp::push_i(idxs,$idx) ), nqp::if( nqp::iseq_i($i,$numind) && nqp::not_i( nqp::isnull(nqp::atposnd(reified,idxs))), nqp::unless( # base pos exists nqp::not_i(nqp::elems(indices)), nqp::atposnd(reified,idxs).EXISTS-POS(|@indices) ) ) ), nqp::stmts( # fewer inds than dims nqp::while( nqp::islt_i(($i = nqp::add_i($i,1)),$numind) && nqp::islt_i( nqp::atpos(indices,$i), nqp::atpos_i(dims,$i)), nqp::null ), nqp::iseq_i($i,$numind) # all clear or oor ) ) ) ) } proto method DELETE-POS(|) {*} multi method DELETE-POS(::?CLASS:U: |c) { self.Any::DELETE-POS(|c) } multi method DELETE-POS(::?CLASS:D:) is raw { die "Must specify at least one index with DELETE-POS" } multi method DELETE-POS(::?CLASS:D: **@indices) { nqp::stmts( (my int $numind = @indices.elems), # reifies (my \indices := nqp::getattr(@indices,List,'$!reified')), (my \reified := nqp::getattr(self,List,'$!reified')), (my int $i = -1), nqp::if( nqp::isge_i( $numind, (my int $numdims = nqp::numdimensions(reified)), ), nqp::stmts( # same or more indices (my \idxs := nqp::list_i), nqp::while( nqp::islt_i( # still indices left ($i = nqp::add_i($i,1)),$numind), nqp::push_i(idxs,nqp::shift(indices)), ), nqp::if( nqp::isnull(my \value := nqp::atposnd(reified,idxs)), Nil, # nothing here nqp::if( nqp::elems(indices), value.DELETE-POS(|@indices), # delete at deeper level nqp::stmts( # found it, nullify here nqp::bindposnd(reified,idxs,nqp::null), value ) ) ) ), X::NotEnoughDimensions.new( # fewer inds than dims operation => 'delete from', got-dimensions => $numind, needed-dimensions => $numdims ).throw ) ) } proto method BIND-POS(|) is raw {*} multi method BIND-POS(::?CLASS:U: |c) is raw { self.Any::BIND-POS(|c) } multi method BIND-POS(::?CLASS:D:) { die "Must specify at least one index and a value with BIND-POS" } multi method BIND-POS(::?CLASS:D: $) { die "Must specify at least one index and a value with BIND-POS" } multi method BIND-POS(::?CLASS:D: **@indices) is raw { nqp::stmts( (my \value := nqp::decont(@indices.pop)), # reifies (my \indices := nqp::getattr(@indices,List,'$!reified')), (my \reified := nqp::getattr(self,List,'$!reified')), (my int $i = -1), nqp::if( nqp::isge_i( (my int $numind = nqp::elems(indices)), (my int $numdims = nqp::numdimensions(reified)), ), nqp::stmts( # same or more indices (my \idxs := nqp::list_i), nqp::while( nqp::islt_i( # still indices left ($i = nqp::add_i($i,1)),$numind), nqp::push_i(idxs,nqp::shift(indices)) ), nqp::if( nqp::elems(indices), nqp::atposnd(reified,idxs) # bind at deeper level .BIND-POS(|@indices,value), nqp::bindposnd(reified,idxs,value) # found it, bind here ) ), X::NotEnoughDimensions.new( # fewer inds than dims operation => 'bind to', got-dimensions => $numind, needed-dimensions => $numdims ).throw ) ) } my class MemCopy does Rakudo::Iterator::ShapeLeaf { has $!from; has $!desc; method !INIT(Mu \to, Mu \from) { nqp::stmts( ($!from := nqp::getattr(from,List,'$!reified')), ($!desc := nqp::getattr(from,Array,'$!descriptor')), self!SET-SELF(to) ) } method new(Mu \to, Mu \from) { nqp::create(self)!INIT(to,from) } method result(--> Nil) { nqp::ifnull( nqp::atposnd($!list,$!indices), nqp::bindposnd($!list,$!indices, nqp::p6scalarfromdesc($!desc)) ) = nqp::atposnd($!from,$!indices) } } sub MEMCPY(Mu \to, Mu \from) { MemCopy.new(to,from).sink-all } my class IntCopy does Rakudo::Iterator::ShapeLeaf { has $!from; method !INIT(Mu \to, Mu \from) { nqp::stmts( ($!from := from), self!SET-SELF(to) ) } method new(Mu \to, Mu \from) { nqp::create(self)!INIT(to,from) } method result(--> Nil) { nqp::ifnull( nqp::atposnd($!list,$!indices), nqp::bindposnd($!list,$!indices,nqp::p6scalarfromdesc(Mu)) ) = nqp::multidimref_i($!from,$!indices) } } sub INTCPY(Mu \to, Mu \from) { IntCopy.new(to,from).sink-all } my class NumCopy does Rakudo::Iterator::ShapeLeaf { has $!from; method !INIT(Mu \to, Mu \from) { nqp::stmts( ($!from := from), self!SET-SELF(to) ) } method new(Mu \to, Mu \from) { nqp::create(self)!INIT(to,from) } method result(--> Nil) { nqp::ifnull( nqp::atposnd($!list,$!indices), nqp::bindposnd($!list,$!indices,nqp::p6scalarfromdesc(Mu)) ) = nqp::multidimref_n($!from,$!indices) } } sub NUMCPY(Mu \to, Mu \from) { NumCopy.new(to,from).sink-all } method !RE-INITIALIZE(::?CLASS:D: --> Nil) { nqp::bindattr( # this is a yucky way to re-init, but it works self,List,'$!reified', nqp::getattr(self.new(:shape(self.shape)),List,'$!reified') ) } proto method STORE(::?CLASS:D: |) {*} multi method STORE(::?CLASS:D: ::?CLASS:D \in, :$INITIALIZE) { nqp::if( in.shape eqv self.shape, nqp::stmts( nqp::unless($INITIALIZE,self!RE-INITIALIZE), MEMCPY(self,in), # VM-supported memcpy-like thing? self ), X::Assignment::ArrayShapeMismatch.new( source-shape => in.shape, target-shape => self.shape ).throw ) } multi method STORE(::?CLASS:D: array:D \in, :$INITIALIZE) { nqp::if( in.shape eqv self.shape, nqp::stmts( nqp::unless($INITIALIZE,self!RE-INITIALIZE), nqp::if( nqp::istype(in.of,Int), INTCPY(self,in), # copy from native int NUMCPY(self,in) # copy from native num ), self ), X::Assignment::ArrayShapeMismatch.new( source-shape => in.shape, target-shape => self.shape ).throw ) } my class StoreIterable does Rakudo::Iterator::ShapeBranch { has $!iterators; has $!desc; method !INIT(\to,\from) { nqp::stmts( self!SET-SELF(to), ($!desc := nqp::getattr(to,Array,'$!descriptor')), ($!iterators := nqp::setelems( nqp::list(from.iterator), nqp::add_i($!maxdim,1) )), self ) } method new(\to,\from) { nqp::create(self)!INIT(to,from) } method done(--> Nil) { nqp::unless( # verify lowest nqp::atpos($!iterators,0).is-lazy # finite iterator || nqp::eqaddr( # and something there nqp::atpos($!iterators,0).pull-one,IterationEnd), nqp::atposnd($!list,$!indices) # boom! ) } method process(--> Nil) { nqp::stmts( (my int $i = $!level), nqp::while( nqp::isle_i(($i = nqp::add_i($i,1)),$!maxdim), nqp::if( nqp::eqaddr((my $item := # exhausted ? nqp::atpos($!iterators,nqp::sub_i($i,1)).pull-one), IterationEnd ), nqp::bindpos($!iterators,$i, # add an empty one Rakudo::Iterator.Empty), nqp::if( # is it an iterator? nqp::istype($item,Iterable) && nqp::isconcrete($item), nqp::bindpos($!iterators,$i,$item.iterator), X::Assignment::ToShaped.new(shape => self.dims).throw ) ) ), (my $iter := nqp::atpos($!iterators,$!maxdim)), nqp::until( # loop over highest dim nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd) || nqp::isgt_i(nqp::atpos_i($!indices,$!maxdim),$!maxind), nqp::stmts( (nqp::ifnull( # containerize if needed nqp::atposnd($!list,$!indices), nqp::bindposnd($!list,$!indices, nqp::p6scalarfromdesc($!desc)) ) = $pulled), nqp::bindpos_i($!indices,$!maxdim, # increment index nqp::add_i(nqp::atpos_i($!indices,$!maxdim),1)) ) ), nqp::unless( nqp::eqaddr($pulled,IterationEnd) # if not exhausted || nqp::isle_i( # and index too high nqp::atpos_i($!indices,$!maxdim),$!maxind) || $iter.is-lazy, # and not lazy nqp::atposnd($!list,$!indices) # error ) ) } } multi method STORE(::?CLASS:D: Iterable:D \in, :$INITIALIZE) { self!RE-INITIALIZE unless $INITIALIZE; StoreIterable.new(self,in).sink-all; self } my class StoreIterator does Rakudo::Iterator::ShapeLeaf { has Mu $!iterator; has Mu $!desc; method !INIT(\list,\iterator) { nqp::stmts( ($!iterator := iterator), ($!desc := nqp::getattr(list,Array,'$!descriptor')), self!SET-SELF(list) ) } method new(\list,\iter) { nqp::create(self)!INIT(list,iter) } method result(--> Nil) { nqp::unless( nqp::eqaddr( (my \pulled := $!iterator.pull-one),IterationEnd), nqp::ifnull( nqp::atposnd($!list,$!indices), nqp::bindposnd($!list,$!indices, nqp::p6scalarfromdesc($!desc)) ) = pulled ) } } multi method STORE(::?CLASS:D: Iterator:D \iterator, :$INITIALIZE) { self!RE-INITIALIZE unless $INITIALIZE; StoreIterator.new(self,iterator).sink-all; self } multi method STORE(::?CLASS:D: Mu \item --> Nil) { X::Assignment::ToShaped.new(shape => self.shape).throw } my class KV does Rakudo::Iterator::ShapeLeaf { has int $!on-key; method result() is raw { nqp::if( ($!on-key = nqp::not_i($!on-key)), nqp::stmts( (my \result := self.indices), (nqp::bindpos_i($!indices,$!maxdim, # back 1 for next nqp::sub_i(nqp::atpos_i($!indices,$!maxdim),1))), result ), nqp::atposnd($!list,$!indices) ) } # needs its own push-all since it fiddles with $!indices method push-all(\target --> IterationEnd) { nqp::until( nqp::eqaddr((my \pulled := self.pull-one),IterationEnd), target.push(pulled) ) } } multi method kv(::?CLASS:D:) { Seq.new(KV.new(self)) } my class Pairs does Rakudo::Iterator::ShapeLeaf { has Mu $!desc; method !INIT(\list) { nqp::stmts( ($!desc := nqp::getattr(list,Array,'$!descriptor')), self!SET-SELF(list) ) } method new(Mu \list) { nqp::create(self)!INIT(list) } method result() { Pair.new( self.indices, nqp::ifnull( nqp::atposnd($!list,$!indices), # By the time the block gets executed, the $!indices # may be at the next iteration already or even reset # because we reached the end. So we need to make # a copy of the indices now. nqp::p6scalarfromdesc(ContainerDescriptor::BindArrayPosND.new( $!desc, $!list, nqp::clone($!indices))) ) ) } } multi method pairs(::?CLASS:D:) { Seq.new(Pairs.new(self)) } my class AntiPairs does Rakudo::Iterator::ShapeLeaf { method result() { Pair.new(nqp::atposnd($!list,$!indices),self.indices) } } multi method antipairs(::?CLASS:D:) { Seq.new(AntiPairs.new(self)) } multi method List(::?CLASS:D: --> List:D) { my \buf := nqp::create(IterationBuffer); self.iterator.push-all(buf); buf.List } multi method Array(::?CLASS:D: --> Array:D) { my @Array := nqp::eqaddr(self.of,Mu) ?? Array.new !! Array[self.of].new; self.iterator.push-all(@Array); @Array } my class Iterate does Rakudo::Iterator::ShapeLeaf { has Mu $!desc; method !INIT(\list) { nqp::stmts( ($!desc := nqp::getattr(list,Array,'$!descriptor')), self!SET-SELF(list) ) } method new(Mu \list) { nqp::create(self)!INIT(list) } method result() is raw { nqp::ifnull( nqp::atposnd($!list,$!indices), # By the time the block gets executed, the $!indices # may be at the next iteration already or even reset # because we reached the end. So we need to make # a copy of the indices now. nqp::p6scalarfromdesc(ContainerDescriptor::BindArrayPosND.new( $!desc, $!list, nqp::clone($!indices))) ) } } method iterator(::?CLASS:D: --> Iterator:D) { Iterate.new(self) } # A shaped array isn't lazy, these methods don't need to go looking # into the "todo". method eager() { self } method sum() is nodal { self.Any::sum } multi method elems(::?CLASS:D: --> Int:D) { nqp::elems(nqp::getattr(self,List,'$!reified')) } method clone(::?CLASS:D:) { my \obj := nqp::create(self); nqp::bindattr(obj,Array,'$!descriptor', nqp::getattr(self,Array,'$!descriptor')); nqp::bindattr(obj,::?CLASS,'$!shape', nqp::getattr(self,::?CLASS,'$!shape')); nqp::p6bindattrinvres(obj,List,'$!reified', nqp::clone(nqp::getattr(self,List,'$!reified'))) } } # vim: ft=perl6 expandtab sw=4