my class Junction { # declared in BOOTSTRAP # class Junction is Mu # has Mu $!eigenstates; # elements of Junction # has str $!type; # type of Junction # Both of these are also accessed directly inside optimizer when # optimizing param typechecks with where clauses method !SET-SELF(str $type,\values) { if nqp::iseq_s($type,"any") || nqp::iseq_s($type,"all") || nqp::iseq_s($type,"none") || nqp::iseq_s($type,"one") { my \iterator := values.iterator; my \buffer := nqp::create(IterationBuffer); nqp::until( nqp::eqaddr((my \pulled := iterator.pull-one),IterationEnd), nqp::push(buffer,nqp::decont(pulled)) ); $!eigenstates := buffer; $!type = $type; self } else { "Junction can only have 'any', 'all', 'none', 'one' type".Failure } } # Swap 2 Junctions in place if they need to be for an infix operation # on the two Junctions. Returns a truthy (0|1)value if the Junctions # were of the same type and can be merged. method INFIX-TWO(Junction:U: Junction:D \a, Junction:D \b ) is implementation-detail { nqp::if( nqp::iseq_s( (my \atype := nqp::getattr(nqp::decont(a),Junction,'$!type')), (my \btype := nqp::getattr(nqp::decont(b),Junction,'$!type')) ), nqp::isne_s(atype,"one"), # same nqp::if( # not same (nqp::iseq_s(btype,"all") || nqp::iseq_s(btype,"none")) && (nqp::iseq_s(atype,"any") || nqp::iseq_s(atype,"one")), nqp::stmts( # need to be swapped nqp::bindattr( (my \ajunc := nqp::clone(nqp::decont(b))), Junction, '$!eigenstates', nqp::getattr(nqp::decont(a),Junction,'$!eigenstates') ), nqp::bindattr( (my \bjunc := nqp::clone(nqp::decont(a))), Junction, '$!eigenstates', nqp::getattr(nqp::decont(b),Junction,'$!eigenstates') ), (a = ajunc), (b = bjunc), 0 # not same, now swapped ) ) ) } proto method new(|) {*} multi method new(Junction: \values, Str :$type!) { nqp::create(Junction)!SET-SELF($type,values) } multi method new(Junction: Str:D \type, \values) { nqp::create(Junction)!SET-SELF(type,values) } method !defined-any() { my \eigenstates := $!eigenstates; my int $i = -1; nqp::while( nqp::islt_i(++$i,nqp::elems(eigenstates)) && nqp::isfalse(nqp::atpos(eigenstates,$i).defined), nqp::null ); nqp::hllbool(nqp::islt_i($i,nqp::elems(eigenstates))) } method !defined-all() { my \eigenstates := $!eigenstates; my int $i = -1; nqp::while( nqp::islt_i(++$i,nqp::elems(eigenstates)) && nqp::atpos(eigenstates,$i).defined, nqp::null ); nqp::hllbool(nqp::iseq_i($i,nqp::elems(eigenstates))) } method !defined-none() { my \eigenstates := $!eigenstates; my int $i = -1; nqp::while( nqp::islt_i(++$i,nqp::elems(eigenstates)) && nqp::isfalse(nqp::atpos(eigenstates,$i).defined), nqp::null ); nqp::hllbool(nqp::iseq_i($i,nqp::elems(eigenstates))) } method !defined-one() { my \eigenstates := $!eigenstates; my int $i = -1; my int $seen; nqp::while( nqp::islt_i(++$i,nqp::elems(eigenstates)) && nqp::isfalse(nqp::atpos(eigenstates,$i).defined) && nqp::not_i($seen++), nqp::null ); nqp::hllbool(nqp::iseq_i($seen,1)) } multi method defined(Junction:D: --> Bool:D) { nqp::iseq_s($!type,'any') ?? self!defined-any !! nqp::iseq_s($!type,'all') ?? self!defined-all !! nqp::iseq_s($!type,'none') ?? self!defined-none !! self!defined-one # nqp::iseq_s($!type,'one') } multi method Bool(Junction:D:) { nqp::hllbool( nqp::stmts( (my int $elems = nqp::elems($!eigenstates)), (my int $i), nqp::if( nqp::iseq_s($!type,'any'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) && nqp::isfalse(nqp::atpos($!eigenstates,$i)), ++$i ), nqp::islt_i($i,$elems) ), nqp::if( nqp::iseq_s($!type,'all'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) && nqp::atpos($!eigenstates,$i), ++$i ), nqp::iseq_i($i,$elems) ), nqp::if( nqp::iseq_s($!type,'none'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) && nqp::isfalse(nqp::atpos($!eigenstates,$i)), ++$i ), nqp::iseq_i($i,$elems) ), nqp::stmts( # $!type eq 'one' (my int $seen = 0), --$i, # increment in condition nqp::while( nqp::islt_i(++$i,$elems) && nqp::isle_i($seen,1), nqp::if( nqp::atpos($!eigenstates,$i), ++$seen ) ), nqp::iseq_i($seen,1) ) ) ) ) ) ) } multi method WHICH(Junction:D: --> ValueObjAt:D) { nqp::if( nqp::defined($!WHICH), $!WHICH, ($!WHICH := nqp::box_s( nqp::concat( nqp::if( nqp::eqaddr(self.WHAT, Junction), 'Junction|', nqp::concat(nqp::unbox_s(self.^name), '|') ), nqp::sha1(self.gist) ), ValueObjAt ))); } multi method ACCEPTS(Junction:U: Junction:D --> True) { } multi method ACCEPTS(Junction:D \SELF: Junction:D \topic) { topic.BOOLIFY-ACCEPTS(self) } multi method ACCEPTS(Junction:D: Mu \topic) { nqp::hllbool( nqp::stmts( (my int $elems = nqp::elems($!eigenstates)), (my int $i), nqp::if( nqp::iseq_s($!type,'any'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) && nqp::isfalse(nqp::atpos($!eigenstates,$i).ACCEPTS(topic)), ++$i ), nqp::islt_i($i,$elems) ), nqp::if( nqp::iseq_s($!type,'all'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) && nqp::atpos($!eigenstates,$i).ACCEPTS(topic), ++$i ), nqp::iseq_i($i,$elems) ), nqp::if( nqp::iseq_s($!type,'none'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) && nqp::isfalse( nqp::atpos($!eigenstates,$i).ACCEPTS(topic) ), ++$i ), nqp::iseq_i($i,$elems) ), nqp::stmts( # $!type eq 'one' (my int $seen), --$i, # increment in condition nqp::while( nqp::islt_i(++$i,$elems) && nqp::isle_i($seen,1), nqp::if( nqp::atpos($!eigenstates,$i).ACCEPTS(topic), ++$seen ) ), nqp::iseq_i($seen,1) ) ) ) ) ) ) } multi method Str (Junction:D:) { self.THREAD: *.Str } multi method Int (Junction:D:) { self.THREAD: *.Int } multi method Numeric (Junction:D:) { self.THREAD: *.Numeric } multi method Real (Junction:D:) { self.THREAD: *.Real } multi method iterator(Junction:D:) { # If we're asked for an iterator, we should really give one rather than # auto-thread over the `iterator` method. Otherwise we get decidedly # confusing outcomes from things that do `.iterator` and then expect it # to follow the iterator API. list(self).iterator } multi method gist(Junction:D:) { my int $elems = nqp::elems($!eigenstates); my int $i = -1; my $gists := nqp::setelems(nqp::list_s,$elems); nqp::bindpos_s($gists,$i,nqp::atpos($!eigenstates,$i).gist) while nqp::islt_i(++$i,$elems); $!type ~ '(' ~ nqp::join(', ',$gists) ~ ')' } multi method raku(Junction:D:) { my int $elems = nqp::elems($!eigenstates); my int $i = -1; my $rakus := nqp::setelems(nqp::list_s,$elems); nqp::bindpos_s($rakus,$i,nqp::atpos($!eigenstates,$i).raku) while nqp::islt_i(++$i,$elems); $!type ~ '(' ~ nqp::join(', ',$rakus) ~ ')' } multi method put() { self.THREAD: *.put } method CALL-ME(|c) { my \storage := nqp::getattr(self, Junction, '$!eigenstates'); my int $elems = nqp::elems(storage); my \result := nqp::setelems(nqp::list, $elems); my int $i = -1; nqp::while( nqp::islt_i(++$i,$elems), nqp::bindpos(result, $i, nqp::atpos(storage, $i)(|c)) ); nqp::p6bindattrinvres( nqp::clone(self), Junction, '$!eigenstates', result) } method sink(Junction:D: --> Nil) { my int $elems = nqp::elems($!eigenstates); my int $i = -1; nqp::atpos($!eigenstates,$i).sink while nqp::islt_i(++$i,$elems); } # Helper method for handling those cases where auto-threading doesn't cut # it. Call the given Callable with each of the Junction values, and return # a Junction with the results of the calls. method THREAD(&call) is implementation-detail { my \storage := nqp::getattr(self,Junction,'$!eigenstates'); my int $i = -1; my int $elems = nqp::elems(storage); my \result := nqp::setelems(nqp::list,$elems); nqp::while( nqp::islt_i(++$i,$elems), nqp::bindpos(result,$i,call(nqp::atpos(storage,$i))) ); nqp::p6bindattrinvres(nqp::clone(self),Junction,'$!eigenstates',result) } method AUTOTHREAD(&call, |args) is implementation-detail { my \positionals := nqp::getattr(nqp::decont(args),Capture,'@!list'); sub thread_junction(int $pos) { my \junction := nqp::decont(nqp::atpos(positionals, $pos)); my \storage := nqp::getattr(junction,Junction,'$!eigenstates'); my int $elems = nqp::elems(storage); my \result := nqp::setelems(nqp::list,$elems); my int $i = -1; nqp::while( nqp::islt_i(++$i,$elems), # Next line is Officially Naughty, since captures are # meant to be immutable. But hey, it's our capture to # be naughty with... nqp::stmts( nqp::bindpos(positionals,$pos,nqp::atpos(storage,$i)), nqp::bindpos(result,$i,call(|args)) ) ); nqp::p6bindattrinvres( nqp::clone(junction),Junction,'$!eigenstates',result) } # Look for a junctional arg in the positionals. # we have to autothread the first all or none junction before # doing any one or any junctions. my int $first_any_one = -1; my int $elems = nqp::elems(positionals); my int $i = -1; my @params := &call.signature.params; while nqp::islt_i(++$i,$elems) { # Junctional positional argument? my Mu $arg := nqp::atpos(positionals, $i); if nqp::istype($arg, Junction) and ( # No auto-threading for Mu or Junction parameters necessary not nqp::istype(Junction, @params[$i].type) # Can't handle protos yet because auto-generated protos # will report Mu as parameter type or &call.?is_dispatcher ) { my str $type = nqp::getattr_s(nqp::decont($arg),Junction,'$!type'); nqp::iseq_s($type,'any') || nqp::iseq_s($type,'one') ?? $first_any_one == -1 ?? ($first_any_one = $i) !! Nil !! return thread_junction($i); } } return thread_junction($first_any_one) if $first_any_one >= 0; # Otherwise, look for one in the nameds. my \nameds := nqp::getattr(nqp::decont(args), Capture, '%!hash'); my \iter := nqp::iterator(nameds); while iter { if nqp::istype(nqp::iterval(nqp::shift(iter)),Junction) { my \junction := nqp::decont(nqp::iterval(iter)); my \storage := nqp::getattr(junction,Junction,'$!eigenstates'); my int $elems = nqp::elems(storage); my \result := nqp::setelems(nqp::list,$elems); my int $i = -1; while nqp::islt_i(++$i,$elems) { # also naughty, like above nqp::bindkey(nameds, nqp::iterkey_s(iter),nqp::atpos(storage,$i)); nqp::bindpos(result,$i,call(|args)); } my \threaded := nqp::clone(nqp::decont(junction)); nqp::bindattr(threaded,Junction,'$!eigenstates',result); return threaded; } } # If we get here, wasn't actually anything to autothread. call(|args); } # BOOLIFY-ACCEPTS is kind of a reverse to ACCEPTS combined with short-circuitting THREAD. The idea is to optimize # smartmatches where a junction is on LHS and RHS ACCEPTS would auto-thread over it. In this case, instead of doing # RHS.ACCEPTS(LHS).Bool, which is what smartmatches are all about, we can reverse the invocation by doing # LHS.BOOLIFY-ACCEPTS(RHS). This wold invoke RHS.ACCEPTS.Bool only on particular eigenstates of LHS. Then, as soon # as the outcome of the whole smartmatch is known, the remaining N eigenstates can be skipped, sparing at least N*2 # method invocations. Note that this can only be used with classes using the default ACCEPTS method from the core as # only with it we can guarantee the default handling of junctions. proto method BOOLIFY-ACCEPTS(|) is implementation-detail {*} multi method BOOLIFY-ACCEPTS(Junction:U, $negate?) { nqp::hllbool(nqp::isfalse($negate)) } multi method BOOLIFY-ACCEPTS(Mu \matcher, $negate?) { my $matches := nqp::stmts( (my int $elems = nqp::elems($!eigenstates)), (my int $i), nqp::if( nqp::iseq_s($!type,'any'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) #?if !moar && matcher.ACCEPTS(nqp::atpos($!eigenstates,$i)).not, #?endif #?if moar && nqp::dispatch('raku-smartmatch', nqp::atpos($!eigenstates, $i), matcher, nqp::unbox_i(-1)), #?endif ++$i ), nqp::islt_i($i,$elems) ), nqp::if( nqp::iseq_s($!type,'all'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) #?if !moar && matcher.ACCEPTS(nqp::atpos($!eigenstates,$i)).Bool, #?endif #?if moar && nqp::dispatch('raku-smartmatch', nqp::atpos($!eigenstates, $i), matcher, nqp::unbox_i(1)), #?endif ++$i ), nqp::iseq_i($i,$elems) ), nqp::if( nqp::iseq_s($!type,'none'), nqp::stmts( nqp::while( nqp::islt_i($i,$elems) #?if !moar && matcher.ACCEPTS(nqp::atpos($!eigenstates,$i)).not, #?endif #?if moar && nqp::dispatch('raku-smartmatch', nqp::atpos($!eigenstates, $i), matcher, nqp::unbox_i(-1)), #?endif ++$i ), nqp::iseq_i($i,$elems) ), nqp::stmts( # $!type eq 'one' (my int $seen = 0), --$i, # increment in condition nqp::while( nqp::islt_i(++$i,$elems) && nqp::isle_i($seen,1), nqp::if( #?if !moar matcher.ACCEPTS(nqp::atpos($!eigenstates,$i)).Bool, #?endif #?if moar nqp::dispatch('raku-smartmatch', nqp::atpos($!eigenstates, $i), matcher, nqp::unbox_i(1)), #?endif ++$seen ) ), nqp::iseq_i($seen,1) ) ) ) ) ); nqp::hllbool(nqp::if($negate, nqp::not_i($matches), $matches)) } } proto sub any(|) is pure {*} #multi sub any(@values) { @values.any } # this breaks S02-literals/radix.t multi sub any(+values) { values.any } proto sub all(|) is pure {*} multi sub all(@values) { @values.all } multi sub all(+values) { values.all } proto sub one(|) is pure {*} multi sub one(@values) { @values.one } multi sub one(+values) { values.one } proto sub none(|) is pure {*} multi sub none(@values) { @values.none } multi sub none(+values) { values.none } proto sub infix:<|>(|) is pure {*} multi sub infix:<|>(+values) { values.any } proto sub infix:<&>(|) is pure {*} multi sub infix:<&>(+values) { values.all } proto sub infix:<^>(|) is pure {*} multi sub infix:<^>(+values) is pure { values.one } multi sub infix:<~>(Str:D $a, Junction:D $b) { nqp::if( $a, nqp::stmts( # something to concat with (my \storage := nqp::bindattr( (my \junction := nqp::clone($b)), Junction, '$!eigenstates', nqp::clone(nqp::getattr($b,Junction,'$!eigenstates')) )), (my int $elems = nqp::elems(storage)), (my int $i = -1), nqp::while( nqp::islt_i(++$i,$elems), nqp::bindpos(storage,$i, nqp::if( nqp::istype((my \value := nqp::atpos(storage,$i)),Junction), infix:<~>($a,value), nqp::concat($a,nqp::if(nqp::istype(value,Str),value,value.Str)) ) ) ), junction ), $b.Str # nothing to concat with ) } multi sub infix:<~>(Junction:D $a, Str:D $b) { nqp::if( $b, nqp::stmts( # something to concat with (my \storage := nqp::bindattr( (my \junction := nqp::clone($a)), Junction, '$!eigenstates', nqp::clone(nqp::getattr($a,Junction,'$!eigenstates')) )), (my int $elems = nqp::elems(storage)), (my int $i = -1), nqp::while( nqp::islt_i(++$i,$elems), nqp::bindpos(storage,$i, nqp::if( nqp::istype((my \value := nqp::atpos(storage,$i)),Junction), infix:<~>(value,$b), nqp::concat(nqp::if(nqp::istype(value,Str),value,value.Str),$b) ) ) ), junction ), $a.Str # nothing to concat with ) } multi sub infix:<~>(Junction:D \a, Junction:D \b) { my int $mergeable = Junction.INFIX-TWO(my $a = a, my $b = b); my \astor := nqp::getattr(nqp::decont($a),Junction,'$!eigenstates'); my \bstor := nqp::getattr(nqp::decont($b),Junction,'$!eigenstates'); my int $aelems = nqp::elems(astor); my int $belems = nqp::elems(bstor); my int $i = -1; my \seen := nqp::hash; my \outer := nqp::bindattr( # outer eigenstates (my \junction := nqp::clone(nqp::decont($a))), Junction, '$!eigenstates', nqp::if( $mergeable, nqp::list, nqp::setelems(nqp::list,$aelems) ) ); nqp::while( # outer loop nqp::islt_i(++$i,$aelems), nqp::stmts( (my \aval := nqp::if( nqp::istype(nqp::atpos(astor,$i),Str), nqp::atpos(astor,$i), nqp::atpos(astor,$i).Str )), (my int $j = -1), nqp::if( $mergeable, nqp::while( # merge eigenstates nqp::islt_i(++$j,$belems), nqp::unless( nqp::existskey( seen, (my \concat := nqp::concat( aval, nqp::if( nqp::istype(nqp::atpos(bstor,$j),Str), nqp::atpos(bstor,$j), nqp::atpos(bstor,$j).Str, ) )) ), nqp::bindkey( # new one, remember seen,nqp::push(outer,concat),1) ) ), nqp::stmts( # cannot merge eigenstates (my \inner := nqp::bindattr( nqp::bindpos(outer,$i,nqp::clone(nqp::decont($b))), Junction, '$!eigenstates', nqp::setelems(nqp::list,$belems) )), nqp::while( nqp::islt_i(++$j,$belems), nqp::bindpos( inner, $j, nqp::concat( aval, nqp::if( nqp::istype(nqp::atpos(bstor,$j),Str), nqp::atpos(bstor,$j), nqp::atpos(bstor,$j).Str, ) ) ) ) ) ) ) ); junction } nqp::p6setautothreader( -> |c { Junction.AUTOTHREAD(|c) } ); Mu.HOW.setup_junction_fallback(Junction, -> $name, |c { my \positionals := nqp::getattr(nqp::decont(c), Capture, '@!list'); my \junction := nqp::decont(nqp::atpos(positionals, 0)); my \storage := nqp::getattr(junction, Junction, '$!eigenstates'); my int $elems = nqp::elems(storage); my \result := nqp::setelems(nqp::list, $elems); my int $i = -1; nqp::shift(positionals); # remove Junction nqp::while( nqp::islt_i(++$i,$elems), nqp::bindpos(result, $i, nqp::atpos(storage, $i)."$name"(|c)) ); nqp::p6bindattrinvres( nqp::clone(junction), Junction, '$!eigenstates', result) } ); # vim: expandtab shiftwidth=4